merge from trunk

7 files changed, 234 insertions, 153 deletions

diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index b0c0bfd7bde..9077bdbb513 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -9355,10 +9355,6 @@ comment at the start of cc-engine.el for more info."
                           containing-sexp nil)))
               (setq lim (1+ containing-sexp))))
         (setq lim (point-min)))
-      (when (c-beginning-of-macro)
-        (goto-char indent-point)
-        (let ((lim1 (c-determine-limit 2000)))
-          (setq lim (max lim lim1))))
 
       ;; If we're in a parenthesis list then ',' delimits the
       ;; "statements" rather than being an operator (with the
diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el
index 11eb0eeaf49..01b5faef5b3 100644
--- a/lisp/progmodes/cfengine.el
+++ b/lisp/progmodes/cfengine.el
@@ -527,6 +527,11 @@ Intended as the value of `indent-line-function'."
   ;; Doze path separators.
   (modify-syntax-entry ?\\ "." table))
 
+(defconst cfengine3--prettify-symbols-alist
+  '(("->"  . ?→)
+    ("=>"  . ?⇒)
+    ("::" . ?∷)))
+
 ;;;###autoload
 (define-derived-mode cfengine3-mode prog-mode "CFE3"
   "Major mode for editing CFEngine3 input.
@@ -538,8 +543,11 @@ to the action header."
   (cfengine-common-syntax cfengine3-mode-syntax-table)
 
   (set (make-local-variable 'indent-line-function) #'cfengine3-indent-line)
+
   (setq font-lock-defaults
-        '(cfengine3-font-lock-keywords nil nil nil beginning-of-defun))
+        '(cfengine3-font-lock-keywords
+          nil nil nil beginning-of-defun))
+  (prog-prettify-install cfengine3--prettify-symbols-alist)
 
   ;; Use defuns as the essential syntax block.
   (set (make-local-variable 'beginning-of-defun-function)
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index d6f136ec92d..d9c482330cc 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -1002,7 +1002,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))))
+        (compile-goto-error nil t))))
 
 ;; This function is the central driver, called when font-locking to gather
 ;; all information needed to later jump to corresponding source code.
@@ -2317,7 +2317,7 @@ 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)
+(defun compile-goto-error (&optional event nomsg)
   "Visit the source for the error message at point.
 Use this command in a compilation log buffer.  Sets the mark at point there."
   (interactive (list last-input-event))
@@ -2328,7 +2328,7 @@ 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)
+    (push-mark nil nomsg)
     (setq compilation-current-error (point))
     (next-error-internal)))
 
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index c6e19fe3a15..b1936467274 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -89,7 +89,7 @@ Used in `octave-mode' and `inferior-octave-mode' buffers.")
 
 (defvar octave-function-header-regexp
   (concat "^\\s-*\\_<\\(function\\)\\_>"
-          "\\([^=;\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>")
+          "\\([^=;(\n]*=[ \t]*\\|[ \t]*\\)\\(\\(?:\\w\\|\\s_\\)+\\)\\_>")
   "Regexp to match an Octave function header.
 The string `function' and its name are given by the first and third
 parenthetical grouping.")
@@ -153,10 +153,10 @@ parenthetical grouping.")
                                 'eldoc-mode))
      :style toggle :selected (or eldoc-post-insert-mode eldoc-mode)
      :help "Display function signatures after typing `SPC' or `('"]
-    ["Delimiter Matching"           smie-highlight-matching-block-mode
-     :style toggle :selected smie-highlight-matching-block-mode
+    ["Delimiter Matching"           show-paren-mode
+     :style toggle :selected show-paren-mode
      :help "Highlight matched pairs such as `if ... end'"
-     :visible (fboundp 'smie-highlight-matching-block-mode)]
+     :visible (fboundp 'smie--matching-block-data)]
     ["Auto Fill"                    auto-fill-mode
      :style toggle :selected auto-fill-function
      :help "Automatic line breaking"]
@@ -540,6 +540,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-start octave-comment-start)
   (setq-local comment-end "")
   (setq-local comment-start-skip octave-comment-start-skip)
@@ -563,6 +564,8 @@ definitions can also be stored in files and used in batch mode."
   (setq-local imenu-generic-expression octave-mode-imenu-generic-expression)
   (setq-local imenu-case-fold-search nil)
 
+  (setq-local add-log-current-defun-function #'octave-add-log-current-defun)
+
   (add-hook 'completion-at-point-functions 'octave-completion-at-point nil t)
   (add-hook 'before-save-hook 'octave-sync-function-file-names nil t)
   (setq-local beginning-of-defun-function 'octave-beginning-of-defun)
@@ -605,12 +608,13 @@ startup."
   :group 'octave
   :version "24.4")
 
-(defcustom inferior-octave-startup-args nil
+(defcustom inferior-octave-startup-args '("-i" "--no-line-editing")
   "List of command line arguments for the inferior Octave process.
 For example, for suppressing the startup message and using `traditional'
-mode, set this to (\"-q\" \"--traditional\")."
+mode, include \"-q\" and \"--traditional\"."
   :type '(repeat string)
-  :group 'octave)
+  :group 'octave
+  :version "24.4")
 
 (defcustom inferior-octave-mode-hook nil
   "Hook to be run when Inferior Octave mode is started."
@@ -664,6 +668,7 @@ in the Inferior Octave buffer.")
   :abbrev-table octave-abbrev-table
   (setq comint-prompt-regexp inferior-octave-prompt)
 
+  (setq-local comment-use-global-state t)
   (setq-local comment-start octave-comment-start)
   (setq-local comment-end "")
   (setq comment-column 32)
@@ -719,13 +724,13 @@ startup file, `~/.emacs-octave'."
                (substring inferior-octave-buffer 1 -1)
                inferior-octave-buffer
                inferior-octave-program
-               (append (list "-i" "--no-line-editing")
-                       ;; --no-gui is introduced in Octave > 3.7
-                       (when (zerop (process-file inferior-octave-program
-                                                  nil nil nil
-                                                  "--no-gui" "--help"))
-                         (list "--no-gui"))
-                       inferior-octave-startup-args))))
+               (append
+                inferior-octave-startup-args
+                ;; --no-gui is introduced in Octave > 3.7
+                (and (not (member "--no-gui" inferior-octave-startup-args))
+                     (zerop (process-file inferior-octave-program
+                                          nil nil nil "--no-gui" "--help"))
+                     '("--no-gui"))))))
     (set-process-filter proc 'inferior-octave-output-digest)
     (setq inferior-octave-process proc
           inferior-octave-output-list nil
@@ -755,10 +760,10 @@ startup file, `~/.emacs-octave'."
     (inferior-octave-send-list-and-digest (list "PS2\n"))
     (when (string-match "\\(PS2\\|ans\\) = *$"
                         (car inferior-octave-output-list))
-      (inferior-octave-send-list-and-digest (list "PS2 (\"> \");\n")))
+      (inferior-octave-send-list-and-digest (list "PS2 ('> ');\n")))
 
     (inferior-octave-send-list-and-digest
-     (list "disp(getenv(\"OCTAVE_SRCDIR\"))\n"))
+     (list "disp (getenv ('OCTAVE_SRCDIR'))\n"))
     (process-put proc 'octave-srcdir
                  (unless (equal (car inferior-octave-output-list) "")
                    (car inferior-octave-output-list)))
@@ -767,19 +772,19 @@ startup file, `~/.emacs-octave'."
     (inferior-octave-send-list-and-digest
      (list "more off;\n"
            (unless (equal inferior-octave-output-string ">> ")
-             "PS1 (\"\\\\s> \");\n")
+             "PS1 ('\\s> ');\n")
            (when (and inferior-octave-startup-file
                       (file-exists-p inferior-octave-startup-file))
-             (format "source (\"%s\");\n" inferior-octave-startup-file))))
+             (format "source ('%s');\n" inferior-octave-startup-file))))
     (when inferior-octave-output-list
       (insert-before-markers
        (mapconcat 'identity inferior-octave-output-list "\n")))
 
     ;; And finally, everything is back to normal.
     (set-process-filter proc 'comint-output-filter)
-    ;; Just in case, to be sure a cd in the startup file
-    ;; won't have detrimental effects.
-    (inferior-octave-resync-dirs)
+    ;; Just in case, to be sure a cd in the startup file won't have
+    ;; detrimental effects.
+    (with-demoted-errors (inferior-octave-resync-dirs))
     ;; Generate a proper prompt, which is critical to
     ;; `comint-history-isearch-backward-regexp'.  Bug#14433.
     (comint-send-string proc "\n")))
@@ -795,7 +800,7 @@ startup file, `~/.emacs-octave'."
        (unless (and (equal (car cache) command)
                     (< (float-time) (+ 5 (cadr cache))))
          (inferior-octave-send-list-and-digest
-          (list (concat "completion_matches (\"" command "\");\n")))
+          (list (format "completion_matches ('%s');\n" command)))
          (setq cache (list command (float-time)
                            (delete-consecutive-dups
                             (sort inferior-octave-output-list 'string-lessp)))))
@@ -894,8 +899,8 @@ output is passed to the filter `inferior-octave-output-digest'."
   "Tracks `cd' commands issued to the inferior Octave process.
 Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused."
   (when inferior-octave-directory-tracker-resync
-    (setq inferior-octave-directory-tracker-resync nil)
-    (inferior-octave-resync-dirs))
+    (or (inferior-octave-resync-dirs 'noerror)
+        (setq inferior-octave-directory-tracker-resync nil)))
   (cond
    ((string-match "^[ \t]*cd[ \t;]*$" string)
     (cd "~"))
@@ -907,13 +912,17 @@ Use \\[inferior-octave-resync-dirs] to resync if Emacs gets confused."
                       (error-message-string err)
                       (match-string 1 string)))))))
 
-(defun inferior-octave-resync-dirs ()
+(defun inferior-octave-resync-dirs (&optional noerror)
   "Resync the buffer's idea of the current directory.
 This command queries the inferior Octave process about its current
 directory and makes this the current buffer's default directory."
   (interactive)
   (inferior-octave-send-list-and-digest '("disp (pwd ())\n"))
-  (cd (car inferior-octave-output-list)))
+  (condition-case err
+      (progn
+        (cd (car inferior-octave-output-list))
+        t)
+    (error (unless noerror (signal (car err) (cdr err))))))
 
 (defcustom inferior-octave-minimal-columns 80
   "The minimal column width for the inferior Octave process."
@@ -931,7 +940,7 @@ directory and makes this the current buffer's default directory."
       (when (and inferior-octave-process
                  (process-live-p inferior-octave-process))
         (inferior-octave-send-list-and-digest
-         (list (format "putenv(\"COLUMNS\", \"%s\");\n" width)))))))
+         (list (format "putenv ('COLUMNS', '%s');\n" width)))))))
 
 
 ;;; Miscellaneous useful functions
@@ -975,16 +984,17 @@ directory and makes this the current buffer's default directory."
 
 (defun octave-goto-function-definition (fn)
   "Go to the function definition of FN in current buffer."
-  (goto-char (point-min))
   (let ((search
          (lambda (re sub)
-           (let (done)
-             (while (and (not done) (re-search-forward re nil t))
+           (let ((orig (point)) found)
+             (goto-char (point-min))
+             (while (and (not found) (re-search-forward re nil t))
                (when (and (equal (match-string sub) fn)
                           (not (nth 8 (syntax-ppss))))
-                 (setq done t)))
-             (or done (goto-char (point-min)))))))
-    (pcase (file-name-extension (buffer-file-name))
+                 (setq found t)))
+             (unless found (goto-char orig))
+             found))))
+    (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)))))
@@ -1345,8 +1355,6 @@ The block marked is the one that contains point or follows point."
               (forward-line 1))))
       t)))
 
-;;; Completions
-
 (defun octave-completion-at-point ()
   "Find the text to complete and the corresponding table."
   (let* ((beg (save-excursion (skip-syntax-backward "w_") (point)))
@@ -1363,6 +1371,16 @@ The block marked is the one that contains point or follows point."
 
 (define-obsolete-function-alias 'octave-complete-symbol
   'completion-at-point "24.1")
+
+(defun octave-add-log-current-defun ()
+  "A function for `add-log-current-defun-function' (which see)."
+  (save-excursion
+    (end-of-line)
+    (and (beginning-of-defun)
+         (re-search-forward octave-function-header-regexp
+                            (line-end-position) t)
+         (match-string 3))))
+
 
 ;;; Electric characters && friends
 (define-skeleton octave-insert-defun
@@ -1387,7 +1405,7 @@ entered without parens)."
   "function " > str \n
   _ \n
   "endfunction" > \n)
-
+
 ;;; Communication with the inferior Octave process
 (defun octave-kill-process ()
   "Kill inferior Octave process and its buffer."
@@ -1506,9 +1524,7 @@ code line."
 (defun octave-eldoc-function-signatures (fn)
   (unless (equal fn (car octave-eldoc-cache))
     (inferior-octave-send-list-and-digest
-     (list (format "\
-if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n"
-                   fn fn)))
+     (list (format "print_usage ('%s');\n" fn)))
     (let (result)
       (dolist (line inferior-octave-output-list)
         (when (string-match
@@ -1605,20 +1621,11 @@ if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n"
     (when (or help-xref-stack help-xref-forward-stack)
       (insert "\n"))))
 
-(defvar octave-help-mode-finish-hook nil
-  "Octave specific hook for `temp-buffer-show-hook'.")
-
-(defun octave-help-mode-finish ()
-  (when (eq major-mode 'octave-help-mode)
-    (run-hooks 'octave-help-mode-finish-hook)))
-
-(add-hook 'temp-buffer-show-hook 'octave-help-mode-finish)
-
 (defun octave-help (fn)
   "Display the documentation of FN."
   (interactive (list (octave-completing-read)))
   (inferior-octave-send-list-and-digest
-   (list (format "help \"%s\"\n" fn)))
+   (list (format "help ('%s');\n" fn)))
   (let ((lines inferior-octave-output-list)
         (inhibit-read-only t))
     (when (string-match "error: \\(.*\\)$" (car lines))
@@ -1654,12 +1661,15 @@ if ismember(exist(\"%s\"), [2 3 5 103]) print_usage(\"%s\") endif\n"
             (help-insert-xref-button (file-relative-name file dir)
                                      'octave-help-file fn)
             (insert "'")))
-        ;; Make 'See also' clickable
+        ;; Make 'See also' clickable.
         (with-syntax-table octave-mode-syntax-table
           (when (re-search-forward "^\\s-*See also:" nil t)
             (let ((end (save-excursion (re-search-forward "^\\s-*$" nil t))))
-              (while (re-search-forward "\\_<\\(?:\\sw\\|\\s_\\)+\\_>" end t)
-                (make-text-button (match-beginning 0) (match-end 0)
+              (while (re-search-forward
+                      ;; Match operators and symbols.
+                      "\\(?1:\\s.+?\\)\\(?:$\\|[,;]\\|\\s-\\)\\|\\_<\\(?1:\\(?:\\sw\\|\\s_\\)+\\)\\_>"
+                      end t)
+                (make-text-button (match-beginning 1) (match-end 1)
                                   :type 'octave-help-function)))))
         (octave-help-mode)))))
 
@@ -1710,23 +1720,30 @@ If the environment variable OCTAVE_SRCDIR is set, it is searched first."
 Functions implemented in C++ can be found if
 `octave-source-directories' is set correctly."
   (interactive (list (octave-completing-read)))
-  (inferior-octave-send-list-and-digest
-   ;; help NAME is more verbose
-   (list (format "\
-if iskeyword(\"%s\") disp(\"`%s' is a keyword\") else which(\"%s\") endif\n"
-                 fn fn fn)))
-  (let* ((line (car inferior-octave-output-list))
-         (file (when (and line (string-match "from the file \\(.*\\)$" line))
-                 (match-string 1 line))))
-    (if (not file)
-        (user-error "%s" (or line (format "`%s' not found" fn)))
-      (require 'etags)
-      (ring-insert find-tag-marker-ring (point-marker))
-      (setq file (funcall octave-find-definition-filename-function file))
-      (when file
-        (find-file file)
-        (octave-goto-function-definition fn)))))
-
+  (require 'etags)
+  (let ((orig (point)))
+    (if (and (derived-mode-p 'octave-mode)
+             (octave-goto-function-definition fn))
+        (ring-insert find-tag-marker-ring (copy-marker orig))
+      (inferior-octave-send-list-and-digest
+       ;; help NAME is more verbose
+       (list (format "\
+if iskeyword('%s') disp('`%s'' is a keyword') else which('%s') endif\n"
+                     fn fn fn)))
+      (let (line file)
+        ;; Skip garbage lines such as
+        ;;     warning: fmincg.m: possible Matlab-style ....
+        (while (and (not file) (consp inferior-octave-output-list))
+          (setq line (pop inferior-octave-output-list))
+          (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)))
+          (ring-insert find-tag-marker-ring (point-marker))
+          (setq file (funcall octave-find-definition-filename-function file))
+          (when file
+            (find-file file)
+            (octave-goto-function-definition fn)))))))
 
 (provide 'octave)
 ;;; octave.el ends here
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 01ac8584e19..1d5052bede4 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -158,44 +158,10 @@
 ;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and
 ;; Jim Campbell <jec@murzim.ca.boeing.com>.
 
-(defcustom perl-prettify-symbols t
-  "If non-nil, some symbols will be displayed using Unicode chars."
-  :version "24.4"
-  :type 'boolean)
-
 (defconst perl--prettify-symbols-alist
-  '(;;("andalso" . ?∧) ("orelse"  . ?∨) ("as" . ?≡)("not" . ?¬)
-    ;;("div" . ?÷) ("*"   . ?×) ("o"   . ?○)
-    ("->"  . ?→)
+  '(("->"  . ?→)
     ("=>"  . ?⇒)
-    ;;("<-"  . ?←) ("<>"  . ?≠) (">="  . ?≥) ("<="  . ?≤) ("..." . ?⋯)
-    ("::" . ?∷)
-    ))
-
-(defun perl--font-lock-compose-symbol ()
-  "Compose a sequence of ascii chars 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) '(?. ?\\))))
-    (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
-            (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
-            (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-string 0)
-                                            perl--prettify-symbols-alist)))))
-  ;; Return nil because we're not adding any face property.
-  nil)
-
-(defun perl--font-lock-symbols-keywords ()
-  (when perl-prettify-symbols
-    `((,(regexp-opt (mapcar 'car perl--prettify-symbols-alist) t)
-       (0 (perl--font-lock-compose-symbol))))))
+    ("::" . ?∷)))
 
 (defconst perl-font-lock-keywords-1
   '(;; What is this for?
@@ -243,8 +209,7 @@ Regexp match data 0 points to the chars."
      ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
      ("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?"
       (1 font-lock-keyword-face) (2 font-lock-constant-face nil t))
-     ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)
-     ,@(perl--font-lock-symbols-keywords)))
+     ("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-constant-face)))
   "Gaudy level highlighting for Perl mode.")
 
 (defvar perl-font-lock-keywords perl-font-lock-keywords-1
@@ -685,13 +650,15 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'."
   (setq-local comment-start-skip "\\(^\\|\\s-\\);?#+ *")
   (setq-local comment-indent-function #'perl-comment-indent)
   (setq-local parse-sexp-ignore-comments t)
+
   ;; Tell font-lock.el how to handle Perl.
   (setq font-lock-defaults '((perl-font-lock-keywords
-                              perl-font-lock-keywords-1
-                              perl-font-lock-keywords-2)
-                             nil nil ((?\_ . "w")) nil
+                              perl-font-lock-keywords-1
+                              perl-font-lock-keywords-2)
+                             nil nil ((?\_ . "w")) nil
                              (font-lock-syntactic-face-function
                               . perl-font-lock-syntactic-face-function)))
+  (prog-prettify-install perl--prettify-symbols-alist)
   (setq-local syntax-propertize-function #'perl-syntax-propertize-function)
   (add-hook 'syntax-propertize-extend-region-functions
             #'syntax-propertize-multiline 'append 'local)
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
new file mode 100644
index 00000000000..e2700414636
--- /dev/null
+++ b/lisp/progmodes/prog-mode.el
@@ -0,0 +1,119 @@
+;;; prog-mode.el --- Generic major mode for programming  -*- lexical-binding: t -*-
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Maintainer: FSF
+;; Keywords: internal
+;; 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 major mode is mostly intended as a parent of other programming
+;; modes.  All major modes for programming languages should derive from this
+;; mode so that users can put generic customization on prog-mode-hook.
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+(defgroup prog-mode nil
+  "Generic programming mode, from which others derive."
+  :group 'languages)
+
+(defvar prog-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map [?\C-\M-q] 'prog-indent-sexp)
+    map)
+  "Keymap used for programming modes.")
+
+(defun prog-indent-sexp (&optional defun)
+  "Indent the expression after point.
+When interactively called with prefix, indent the enclosing defun
+instead."
+  (interactive "P")
+  (save-excursion
+    (when defun
+      (end-of-line)
+      (beginning-of-defun))
+    (let ((start (point))
+          (end (progn (forward-sexp 1) (point))))
+      (indent-region start end nil))))
+
+(defvar prog-prettify-symbols-alist nil)
+
+(defcustom prog-prettify-symbols nil
+  "Whether symbols should be prettified.
+When set to an alist in the form `((STRING . CHARACTER)...)' it
+will augment the mode's native prettify alist."
+  :type '(choice
+          (const :tag "No thanks" nil)
+          (const :tag "Mode defaults" t)
+          (alist :tag "Mode defaults augmented with your own list"
+                 :key-type string :value-type character))
+  :version "24.4")
+
+(defun prog--prettify-font-lock-compose-symbol (alist)
+  "Compose a sequence of ascii chars 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) '(?. ?\\))))
+    (if (or (memq (char-syntax (or (char-before start) ?\ )) syntaxes)
+            (memq (char-syntax (or (char-after end) ?\ )) syntaxes)
+            (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-string 0) alist)))))
+  ;; Return nil because we're not adding any face property.
+  nil)
+
+(defun prog-prettify-font-lock-symbols-keywords ()
+  (when prog-prettify-symbols
+    (let ((alist (append prog-prettify-symbols-alist
+                         (if (listp prog-prettify-symbols)
+                             prog-prettify-symbols
+                           nil))))
+      `((,(regexp-opt (mapcar 'car alist) t)
+         (0 (prog--prettify-font-lock-compose-symbol ',alist)))))))
+
+(defun prog-prettify-install (alist)
+"Install prog-mode support to prettify symbols according to ALIST.
+
+ALIST is in the format `((STRING . CHARACTER)...)' like
+`prog-prettify-symbols'.
+
+Internally, `font-lock-add-keywords' is called."
+  (setq-local prog-prettify-symbols-alist alist)
+  (let ((keywords (prog-prettify-font-lock-symbols-keywords)))
+    (if keywords (font-lock-add-keywords nil keywords))))
+
+;;;###autoload
+(define-derived-mode prog-mode fundamental-mode "Prog"
+  "Major mode for editing programming language source code."
+  (set (make-local-variable 'require-final-newline) mode-require-final-newline)
+  (set (make-local-variable 'parse-sexp-ignore-comments) t)
+  ;; Any programming language is always written left to right.
+  (setq bidi-paragraph-direction 'left-to-right))
+
+(provide 'prog-mode)
+
+;;; prog-mode.el ends here
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index 63bd9258d69..0f3c1504ee9 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1149,11 +1149,7 @@ VERSION is of the format (Major . Minor)"
   (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)
-       ;; This complex regexp makes sure that comments cannot start
-       ;; inside quoted atoms or strings
-       (format "^\\(\\(%s\\|%s\\|[^\n\'\"%%]\\)*\\)\\(/\\*+ *\\|%%+ *\\)"
-               prolog-quoted-atom-regexp prolog-string-regexp))
+  (set (make-local-variable 'comment-start-skip) "\\(?:/\\*+ *\\|%%+ *\\)")
   (set (make-local-variable 'parens-require-spaces) nil)
   ;; Initialize Prolog system specific variables
   (dolist (var '(prolog-keywords prolog-types prolog-mode-specificators
@@ -1739,8 +1735,7 @@ This function must be called from the source code buffer."
          (real-file buffer-file-name)
          (command-string (prolog-build-prolog-command compilep file
                                                       real-file first-line))
-         (process (get-process "prolog"))
-         (old-filter (process-filter process)))
+         (process (get-process "prolog")))
     (with-current-buffer buffer
       (delete-region (point-min) (point-max))
       ;; FIXME: Wasn't this supposed to use prolog-inferior-mode?
@@ -1759,8 +1754,7 @@ This function must be called from the source code buffer."
                'prolog-parse-sicstus-compilation-errors))
       (setq buffer-read-only nil)
       (insert command-string "\n"))
-    (save-selected-window
-      (pop-to-buffer buffer))
+    (display-buffer buffer)
     (setq prolog-process-flag t
           prolog-consult-compile-output ""
           prolog-consult-compile-first-line (if first-line (1- first-line) 0)
@@ -1954,20 +1948,6 @@ If COMPILEP is non-nil, compile, otherwise consult."
 ;;-------------------------------------------------------------------
 
 ;; Auxiliary functions
-(defun prolog-make-keywords-regexp (keywords &optional protect)
-  "Create regexp from the list of strings KEYWORDS.
-If PROTECT is non-nil, surround the result regexp by word breaks."
-  (let ((regexp
-         (if (fboundp 'regexp-opt)
-             ;; Emacs 20
-             ;; Avoid compile warnings under earlier versions by using eval
-             (eval '(regexp-opt keywords))
-           ;; Older Emacsen
-           (concat (mapconcat 'regexp-quote keywords "\\|")))
-         ))
-    (if protect
-        (concat "\\<\\(" regexp "\\)\\>")
-      regexp)))
 
 (defun prolog-font-lock-object-matcher (bound)
   "Find SICStus objects method name for font lock.
@@ -2084,20 +2064,16 @@ Argument BOUND is a buffer position limiting searching."
             (if (eq prolog-system 'mercury)
                 (concat
                  "\\<\\("
-                 (prolog-make-keywords-regexp prolog-keywords-i)
+                 (regexp-opt prolog-keywords-i)
                  "\\|"
-                 (prolog-make-keywords-regexp
+                 (regexp-opt
                   prolog-determinism-specificators-i)
                  "\\)\\>")
               (concat
                "^[?:]- *\\("
-               (prolog-make-keywords-regexp prolog-keywords-i)
+               (regexp-opt prolog-keywords-i)
                "\\)\\>"))
               1 prolog-builtin-face))
-          (quoted_atom (list prolog-quoted-atom-regexp
-                             2 'font-lock-string-face 'append))
-          (string (list prolog-string-regexp
-                        1 'font-lock-string-face 'append))
           ;; SICStus specific patterns
           (sicstus-object-methods
            (if (eq prolog-system 'sicstus)
@@ -2107,17 +2083,17 @@ Argument BOUND is a buffer position limiting searching."
           (types
            (if (eq prolog-system 'mercury)
                (list
-                (prolog-make-keywords-regexp prolog-types-i t)
+                (regexp-opt prolog-types-i 'words)
                 0 'font-lock-type-face)))
           (modes
            (if (eq prolog-system 'mercury)
                (list
-                (prolog-make-keywords-regexp prolog-mode-specificators-i t)
+                (regexp-opt prolog-mode-specificators-i 'words)
                 0 'font-lock-constant-face)))
           (directives
            (if (eq prolog-system 'mercury)
                (list
-                (prolog-make-keywords-regexp prolog-directives-i t)
+                (regexp-opt prolog-directives-i 'words)
                 0 'prolog-warning-face)))
           ;; Inferior mode specific patterns
           (prompt
@@ -2211,8 +2187,6 @@ Argument BOUND is a buffer position limiting searching."
          (list
           head-predicates
           head-predicates-1
-          quoted_atom
-          string
           variables
           important-elements
           important-elements-1