Posted by Marco Pessotto on Thu 7 Feb 18:49
report abuse | download | new post
- ;;; pov-mode.el --- major mode for Povray scene files
- ;;
- ;; Author: Peter Boettcher <pwb@andrew.cmu.edu>
- ;; Maintainer: Peter Toneby <woormie@acc.umu.se>
- ;; Created: 04 March 1994
- ;; Modified: 05 Feb 2008
- ;; Version: 2.10-pl1
- ;; Keywords: pov, povray
- ;;
- ;; Modified by: Marco Pessotto <marco.erika@gmail.com>
- ;; 1/5/2008
- ;; Workaround for Emacs 22
- ;; Peter Toneby no more maintains pov-mode :-(
- ;;
- ;; LCD Archive Entry:
- ;; povray|Peter Toneby|woormie@acc.umu.se|
- ;; Major mode for Povray scene files|
- ;; 08-Sep-2003|2.10|~/lib/emacs/pov-mode.el|
- ;;
- ;; Copyright (C) 1997 Peter W. Boettcher
- ;;
- ;; 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 2, or (at your option)
- ;; any later version.
- ;; This program is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;;
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs; see the file COPYING. If not, write to
- ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
- ;;
- ;;; Commentary:
- ;;
- ;; This major mode for GNU Emacs provides support for editing Povray
- ;; scene files, rendering and viewing them. It automatically indents
- ;; blocks, both {} and #if #end. It also provides context-sensitive
- ;; keyword completion and font-lock highlighting, as well as the
- ;; ability to look up those keywords in the povray docu.
- ;;
- ;; It should work for either Xemacs or FSF Emacs, versions >= 20;
- ;; however, only Xemacs can display pictures.
- ;;
- ;; To automatically load pov-mode every time Emacs starts up, put the
- ;; following line into your .emacs file:
- ;;
- ;; (require 'pov-mode)
- ;;
- ;; Of course pov-mode has to be somewhere in your load-path for emacs
- ;; to find it (Use C-h v load-path to see which directories are in the
- ;; load-path).
- ;;
- ;; NOTE: To achieve any sort of reasonable performance, YOU MUST
- ;; byte-compile this package. In emacs, type M-x byte-compile
- ;; and then enter the name of this file.
- ;;
- ;; You can customize the behaviour of pov-mode and via the
- ;; customization menu or by simply entering M-x customize-group pov.
- ;; In many or even most cases, however, it should be completely
- ;; sufficient to to rely on the default settings.
- ;;
- ;; To learn about the basics, just load a pov-file and press C-h m.
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;;Modified by: Peter Boettcher <pwb@andrew.cmu.edu>
- ;; 5/8/97:
- ;; Added font-lock support for Emacs/XEmacs 19
- ;; Indent under `#declare Object=' lines
- ;; Corrected comment syntax
- ;; Got rid of more remnants from postscript mode
- ;; General cleanup
- ;; Arbitrarily chose version 1.2
- ;; 5/8/97: Version 1.21
- ;; fontify-insanely was ignored. fixed.
- ;;
- ;; 9/24/97: Version 1.3
- ;; Added indentation for Pov 3 syntax (#if #else, etc)
- ;; Preliminary context-sensitive keyword completion
- ;;
- ;; 1/13/98 by Peter Boettcher <pwb@andrew.cmu.edu>
- ;; Explicitly placed package under GPL
- ;; Reorganized comment sections and change log to follow GNU standards
- ;; Added simple code for jumping to pov documentation (Thanks to
- ;; Benjamin Strautin <bis@acpub.duke.edu> for this code)
- ;;
- ;; Modified by: Peter Toneby <woormie@acc.umu.se>
- ;; 22/3/99: Version 1.99beata1
- ;; Added support for Pov3.1s new keywords. (not all, I think...)
- ;; Removed atmosphere (and atmosphere_*) (stupid me...)
- ;;
- ;; Modified by: Peter Toneby <woormie@acc.umu.se>
- ;; 23/4/99: Version 1.99beata2
- ;; Added support for all new keyword, BUT
- ;; Added atmosphere (and atmosphere_*) again
- ;; Got Pete Boettchers blessing to continue (but with a note
- ;; that said that I should have talked to him first, I'm sorry
- ;; for not doing that). Pete also said he was willing to let
- ;; me continue the maintainance of this file.
- ;; I can't get the pov-keyword-help to work, anyone with knowledge
- ;; about elisp can send me a fix for it.
- ;; The keyword expansion doesn't work for all keywords,
- ;; I need to add lots of stuff and read through the docs
- ;; to get everything correct.
- ;;
- ;; Modified by: Alexander Schmolck <aschmolck@gmx.de>
- ;; 2000-01-31: Version 2beataXXX
- ;; Added working keyword lookup in povuser.txt
- ;; Added rendering and viewing from within Emacs and with an external viewer
- ;; Added customization and made installation simpler
- ;; Added a few other minor details
- ;;
- ;; Modified by: Peter Toneby <woormie@acc.umu.se>
- ;; 2000-05-24: Version 2
- ;; Changed the keyword lookup a little, povuser.txt didn't open as
- ;; expected when having set the pov-home-dir and pov-help-file
- ;; manually.
- ;;
- ;; Modified by: Peter Toneby <woormie@acc.umu.se>
- ;; 2000-08-10: Version 2.5b1
- ;; Added povray-font-lock-faces.
- ;; Made sure font-lock works properly on:
- ;; XEmacs 19.15p7
- ;; XEmacs 20.0
- ;; XEmacs 21.1p10
- ;; Emacs 19.29.1
- ;; Emacs 20.7.2
- ;; Added all 3.1 keywords except track, since I don't know what it
- ;; is, I have also dropped the 3.0 specific keywords that
- ;; shouldn't be used anymore.
- ;; Fixed some completion stuff, I think I have added all keywords to
- ;; the completions.
- ;; Added configureation for all faces. To bad I can't get the defaults
- ;; to work properly on dark backgrounds, I don't know why that is.
- ;; Added a toolbar, it replaces to standard XEmacs toolbar, I think
- ;; that is the best thing to do, but I retain the standard useful
- ;; functionality.
- ;; Fixed an error in the external viewer, it used variables that were
- ;; not available in the same scope as the sentinel.
- ;; Added basic imenu support, currently only #local and #declare,
- ;; but I will try to add objects, cameras and lightsources later.
- ;; 2000-09-12 Version 2.5.b2
- ;; Added basic support for megapov
- ;; Bob Pepin fixed a bug in test to select external/internal viewer.
- ;; fortsätt på kapitel 5.6
- ;; 2001-04-05 Version 2.6
- ;; Added the capability to open standard include files by pressing
- ;; C-c i. It opens the file entered ro.
- ;; Fixed leeking color in emacs (Robert Kleemann)
- ;; Changed the rendertoolbarbutton to show a popup dialog with buttons
- ;; for the different qualities.
- ;; 2001-12-07 Version 2.7
- ;; Fixed font-locks for Emacs 21
- ;; 2002-06-19 Version 2.8
- ;; Fixed loading for Emacs 21-2, missed a test for customizations
- ;; Added most parts of a patch from Christoph Hormann that cleaned
- ;; up the Regexp mess, and added all (or at least most) of the
- ;; keywords for 3.5 Parts of that patch are still missing, I'll
- ;; get around to those sometime...
- ;; 2002-08-07 Version 2.9
- ;; Added Insert menu, it uses the directory structure of the winpov
- ;; insert menu.
- ;; Moved the toolbar icons out to separate xpm-files.
- ;; Added some missing keyword expansions
- ;; Fixed so that box, cylinder... has their own face, object-face,
- ;; removed unused faces
- ;; Cleaned up the code, removed unused stuff.
- ;; It works in versions 21, can't test in 20, font-lock is borked for me.
- ;; 2002-08-10 Version 2.9.1
- ;; Fixed so that tollbar icons are searched for, not hard coded.
- ;; 2003-08-29 Version 2.10
- ;; Fixed references to povray.el.
- ;; Fixed cut-n-pasted comment for font-pov-operator-face.
- ;; Fixed the insert menus, they missed the last items, thanks to Hartwig
- ;; Bosse for the heads up, and a fix.
- ;; 2003-08-29 Version 2.11 (This is a future version)
- ;; Fix a bug with rendering so that the active buffer is changed to the
- ;; correct buffer, found by Hartwig Bosse.
- ;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;; Original Author: Kevin O. Grover <grover@isri.unlv.edu>
- ;; Cre Date: 04 March 1994
- ;; This file derived from postscript mode by Chris Maio
- ;;
- ;; Please send bug reports/comments/suggestions to Peter Toneby
- ;; woormie@acc.umu.se
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;; TODO list:
- ;; * Vector operations (add <0, .5, 1> to every vector in region)
- ;; * Clean up completion code
- ;; * TAGS, to jump to #declared objects elsewhere in the code
- ;; * c-mode like electric parens (?)
- ;; * clean up viewing and rendering code
- ;; * should render or view be decided on filedates? If so, what
- ;; image file-name extensions should be checked?
- ;; I think PNG is default for UNIX, not sure.
- ;; I could make this a customizeation option.
- ;; * imenu support
- ;; started, but needs to be fixed so it handles nested menus.
- ;; * Make sure the scopes are correct
- ;; * Make hooks for menus, so they are userselectable
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; Better safe than sorry, lets fail if you are using a (very?) old
- ;; version of (X)Emacs.
- (if (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version)))
- (and (= emacs-major-version 19) (< emacs-minor-version 14))
- (and (= emacs-major-version 19) (< emacs-minor-version 29)))
- (error "`font-pov' was written for Emacs 19.29/XEmacs 19.14 or later"))
- (defvar font-pov-is-XEmacs19
- (and (not (null (save-match-data
- (string-match "XEmacs\\|Lucid" emacs-version))))
- (= 19 emacs-major-version)))
- (defvar font-pov-is-XEmacs20
- (and (not (null (save-match-data
- (string-match "XEmacs\\|Lucid" emacs-version))))
- (<= 20 emacs-major-version)))
- (defvar font-pov-is-XEmacs21
- (and (not (null (save-match-data
- (string-match "XEmacs\\|Lucid" emacs-version))))
- (<= 21 emacs-major-version)))
- (defvar font-pov-is-XEmacs20-2
- (or (and font-pov-is-XEmacs20 (<= 2 emacs-minor-version))
- font-pov-is-XEmacs21))
- (defvar font-pov-is-Emacs19
- (and (not font-pov-is-XEmacs19)
- (not font-pov-is-XEmacs20)
- (= 19 emacs-major-version)))
- (defvar font-pov-is-Emacs20
- (and (not font-pov-is-XEmacs19)
- (not font-pov-is-XEmacs20)
- (= 20 emacs-major-version)))
- (defvar font-pov-is-Emacs21
- (and (not font-pov-is-XEmacs19)
- (not font-pov-is-XEmacs20)
- (not font-pov-is-XEmacs21)
- (= 21 emacs-major-version)))
- (defvar font-pov-is-Emacs22
- (and (not font-pov-is-XEmacs19)
- (not font-pov-is-XEmacs20)
- (not font-pov-is-XEmacs21)
- (= 22 emacs-major-version)))
- (defvar font-pov-is-Emacs
- (or font-pov-is-Emacs19
- font-pov-is-Emacs20
- font-pov-is-Emacs21
- font-pov-is-Emacs22))
- (require 'cl)
- (require 'font-lock) ;;[TODO] Not nice to reqire it, the user should
- ;; have a choise...
- (defconst pov-mode-version '2.10
- "The povray mode version.")
- (defvar pov-tab-width 8)
- (defvar pov-autoindent-endblocks t)
- ;;Create fontfaces
- (defvar font-pov-number-face 'font-pov-number-face
- "Face to use for PoV numbers.")
- (defvar font-pov-variable-face 'font-pov-variable-face
- "Face to use for PoV variables.")
- (defvar font-pov-directive-face 'font-pov-directive-face
- "Face to use for PoV directives.")
- (defvar font-pov-object-face 'font-pov-object-face
- "Face to use for PoV objects.")
- ;(defvar font-pov-object-modifier-face 'font-pov-object-modifier-face
- ; "Face to use for PoV objects.")
- ;(defvar font-pov-texture-face 'font-pov-texture-face
- ; "Face to use for PoV objects.")
- (defvar font-pov-operator-face 'font-pov-operator-face
- "Face to use for PoV operators.")
- (defvar font-pov-csg-face 'font-pov-csg-face
- "Face to use for PoV csg keywords.")
- ;(defvar font-pov-string-face nil
- ; "Face to use for strings. This is set by font-PoV.")
- (defvar font-pov-macro-name-face nil
- "Face to use for strings. This is set by font-PoV.")
- (defvar font-pov-keyword-face nil
- "Face to use for misc keywords. This is set by font-PoV.")
- (defvar pov-insertmenu-location nil
- "Location of the InsertMenu directory structure.")
- (defvar pov-icons-location nil
- "Location of the menubaricons.")
- ; Seems like Emacs lacks these functions (locate-data-[directory|file])...
- (unless (fboundp 'locate-data-directory)
- (defun locate-data-directory (name &optional dirs)
- (if dirs
- (if (file-directory-p (expand-file-name name (car dirs)))
- (expand-file-name name (car dirs))
- (locate-data-directory name (cdr dirs)))
- (expand-file-name name data-directory))))
- (unless (fboundp 'locate-data-file)
- (defun locate-data-file (name &optional dirs)
- (print dirs)
- (if dirs
- (if (file-regular-p (expand-file-name name (car dirs)))
- (expand-file-name name (car dirs))
- (locate-data-file name (cdr dirs)))
- (expand-file-name name data-directory))))
- ;; This is because FSFEmacs has a ridiculusly low max-lisp-eval-depth
- (when (> 1000 max-lisp-eval-depth)
- (customize-set-value 'max-lisp-eval-depth 1000))
- ;; Yup XEmacs didn't get cutomizations until 20.2.
- (cond ((or font-pov-is-XEmacs20-2 (or font-pov-is-Emacs20 font-pov-is-Emacs21 font-pov-is-Emacs22))
- (defgroup pov nil
- "*Major mode for editing povray 3.X scence files <http://www.povray.org>."
- :group 'languages)
- (defcustom povray-command "povray"
- "*Command used to invoke the povray."
- :type 'string
- :group 'pov)
- (defcustom pov-external-viewer-command "xv"
- "*The external viewer to call."
- :type 'string
- :group 'pov)
- (defcustom pov-external-view-options "%s"
- "*The options for the viewer; %s is replaced with the name of the rendered image."
- :type 'string
- :group 'pov)
- ;;allow user to customize external or internal viewer as defaults if she
- ;;is using Xemacs; for FSF Emacs assume external, since it can't
- ;;handle pictures anyway
- ;(if (and (boundp 'running-xemacs) running-xemacs)
- (defcustom pov-default-view-internal t
- "*Should the pictures be displayed internally by default?"
- :type 'boolean
- :group 'pov)
- ;(defvar pov-default-view-internal nil))
- (defcustom pov-run-default "+i%s"
- "*The default options for the Render command (%s is replaced by the filename)."
- :type 'string
- :group 'pov
- )
- (defcustom pov-run-test "res120 -Q3 +i%s"
- "*The default options for the Test Render command (%s is replaced by the filename)."
- :type 'string
- :group 'pov
- )
- (defcustom pov-run-low "res320 +i%s"
- "*The default options for the Test Render command (%s is replaced by the filename)."
- :type 'string
- :group 'pov
- )
- (defcustom pov-run-mid "res640 +i%s"
- "*The default options for the Medium Res Render command (%s is replaced by the filename)."
- :type 'string
- :group 'pov
- )
- (defcustom pov-run-high "res800 +i%s"
- "*The default options for the High Res Render command (%s is replaced by the filename)."
- :type 'string
- :group 'pov
- )
- (defcustom pov-run-highest "res1k +i%s"
- "*The default options for the Higest Res Render command (%s is replaced by the filename)."
- :type 'string
- :group 'pov
- )
- (defvar pov-external-view
- "External view")
- (defvar pov-internal-view
- "Internal view")
- (defvar pov-command-alist (list (list "Render"
- povray-command pov-run-default
- '()) ;history for the command
- (list "Test quality render"
- povray-command pov-run-test
- '())
- (list "Low quality render"
- povray-command pov-run-low
- '())
- (list "Medium quality render"
- povray-command pov-run-highest
- '())
- (list "High quality render"
- povray-command pov-run-high
- '())
- (list pov-external-view
- pov-external-viewer-command
- pov-external-view-options
- '())
- (list pov-internal-view
- (list pov-internal-view)
- '()))
- "the commands to run")
- (defcustom pov-home-dir "SHARELIBSPOVRAY"
- "*The directory in which the povray files reside."
- :type 'directory
- :group 'pov)
- (defcustom pov-include-dir "SHARELIBSPOVRAY/include"
- "*The directory in which the povray includefiles reside."
- :type 'directory
- :group 'pov)
- (defcustom pov-help-file "povuser.txt"
- "*The name of the helpfile."
- :type 'file
- :group 'pov)
- (defcustom pov-associate-pov-and-inc-with-pov-mode-flag t
- "*If t then files ending with .pov and .inc will automatically start
- pov-mode when loaded, unless those file-endings are already in use."
- :type 'boolean
- :group 'pov)
- (defcustom pov-fontify-insanely t
- "*Non-nil means colorize every povray keyword. This may take a while on large files. Maybe disable this on slow systems."
- :type 'boolean
- :group 'pov)
- (defcustom pov-imenu-in-menu t
- "*Non-nil means have #locals and #declares in a menu called PoV in the menubar. This may take a while on large files. Maybe disable this on slow systems."
- :type 'boolean
- :group 'pov)
- ;; CH
- (defcustom pov-imenu-only-macros t
- "*Non-nil means to restrict imenu to macro declarations."
- :type 'boolean
- :group 'pov)
- ;; /end CH
- (defcustom pov-indent-level 2
- "*Indentation to be used inside of PoVray blocks or arrays."
- :type 'integer
- :group 'pov)
- (defcustom pov-autoindent-endblocks t
- "*When non-nil, automatically reindents when you type break, end, or else."
- :type 'boolean
- :group 'pov
- )
- (defcustom pov-indent-under-declare 2
- "*Indentation under a `#declare Object=' line."
- :type 'integer
- :group 'pov)
- (defcustom pov-tab-width 8
- "*Tab stop width for PoV mode."
- :type 'integer
- :group 'pov)
- (defcustom pov-turn-on-font-lock t
- "*Turn on syntax highlighting automatically"
- :type 'boolean
- :group 'pov)
- (defcustom font-pov-csg-face t
- "*What color does CSG-object have"
- :type 'face
- :group 'pov)
- (defcustom font-pov-object-face t
- "*What color does objects have"
- :type 'face
- :group 'pov)
- (defcustom font-pov-variable-face t
- "*What color does variables (in declarations) have"
- :type 'face
- :group 'pov)
- ; (defcustom font-pov-string-face t
- ; "*What color does strings have"
- ; :type 'face
- ; :group 'pov)
- ; (defcustom font-pov-texture-face t
- ; "*What color does textures have"
- ; :type 'face
- ; :group 'pov)
- ; (defcustom font-pov-object-modifier-face t
- ; "*What color does object modifiers have"
- ; :type 'face
- ; :group 'pov)
- (defcustom font-pov-directive-face t
- "*What color does (#)-directives have"
- :type 'face
- :group 'pov)
- (defcustom font-pov-number-face t
- "*What color does numbers have"
- :type 'face
- :group 'pov)
- (defcustom font-pov-keyword-face t
- "*What color does keywords have"
- :type 'face
- :group 'pov)
- )
- )
- ; Find where the menubar icons are placed, should be where pov-mode is...
- ;; (setq pov-icons-location
- ;; (file-name-directory (locate-data-file "povrender.xpm"
- ;; (cons (file-name-directory (locate-library "pov-mode"))
- ;; (if font-pov-is-Emacs data-directory data-directory-list)))))
- ;;FIX ME
- (setq pov-icons-location "EMACSLISPLIBRARY/povrender.xpm")
- ;; Lets play with the Toolbar, we want to add buttons for
- ;; rendering and showing images, lets place them on the rightmost
- ;; position of the toolbar.
- (cond ((or font-pov-is-XEmacs20 font-pov-is-XEmacs21)
- (defvar toolbar-render-icon
- (if (featurep 'xpm)
- (let ((rendericon (concat pov-icons-location "povrender.xpm")))
- (toolbar-make-button-list (make-image-instance (vector 'xpm :file rendericon))))
- ))
- (defvar toolbar-look-icon
- (if (featurep 'xpm)
- (let ((viewicon (concat pov-icons-location "povview.xpm")))
- (toolbar-make-button-list (make-image-instance (vector 'xpm :file viewicon))))
- ))
- (defvar pov-toolbar
- '(
- [toolbar-file-icon toolbar-open t "Open a file"]
- [toolbar-folder-icon toolbar-dired t "Edit a directory"]
- [toolbar-disk-icon toolbar-save t "Save buffer"]
- [toolbar-printer-icon toolbar-print t "Print buffer"]
- [toolbar-cut-icon toolbar-cut t "Kill region"]
- [toolbar-copy-icon toolbar-copy t "Copy region"]
- [toolbar-paste-icon toolbar-paste t "Paste from clipboard"]
- [toolbar-undo-icon toolbar-undo t "Undo edit"]
- [toolbar-spell-icon toolbar-ispell t "Check spelling"]
- [toolbar-replace-icon toolbar-replace t "Search & Replace"]
- nil
- [toolbar-render-icon (pov-render-dialog) t "Configured Render the file"]
- ; [toolbar-render-icon
- ; (pov-render-file "Render" (buffer-file-name) nil)
- ; t "Quick Render the file"]
- [toolbar-look-icon
- (if pov-default-view-internal
- (pov-display-image-xemacs pov-image-file)
- (pov-display-image-externally pov-image-file nil))
- t "Show the rendered file"]
- ))
- (defvar pov-render-dialog-desc
- '("Render Image"
- ["Test render" (pov-render-file "Test quality render" (buffer-file-name) nil) t]
- ["Low render" (pov-render-file "Low quality render" (buffer-file-name) nil) t]
- ["Medium render" (pov-render-file "Medium quality render" (buffer-file-name) nil) t]
- ["High render" (pov-render-file "High quality render" (buffer-file-name) nil) t]
- ["Render" (pov-render-file "Render" (buffer-file-name) nil) t]
- ["Cancel" (pov-render-file "Render" (buffer-file-name) nil) t]
- ))
- ))
- (defun pov-toolbar ()
- (interactive)
- (set-specifier default-toolbar (cons (current-buffer) pov-toolbar)))
- ;; Menubar stuff, buttonmenu will be nice to have too.
- ;; Abbrev support
- (defvar pov-mode-abbrev-table nil
- "Abbrev table in use in pov-mode buffers.")
- (define-abbrev-table 'pov-mode-abbrev-table ())
- (cond ((or font-pov-is-XEmacs20-2 font-pov-is-Emacs20)
- (when pov-turn-on-font-lock
- (turn-on-font-lock))
- ;; associate *.pov and *.inc with pov if flag is set and no other
- ;; modes already have
- (cond (pov-associate-pov-and-inc-with-pov-mode-flag
- (when (not (assoc "\\.pov\\'" auto-mode-alist))
- (setq auto-mode-alist
- (append '(("\\.pov\\'" . pov-mode)) auto-mode-alist)))
- (when (not (assoc "\\.inc\\'" auto-mode-alist))
- (setq auto-mode-alist
- (append '(("\\.inc\\'" . pov-mode)) auto-mode-alist)))))
- ))
- ;;END AS
- (defvar font-pov-do-multi-line t
- "*Set this to nil to disable the multi-line fontification prone to infinite loop bugs.")
- (defun font-pov-setup ()
- "Setup this buffer for PoV font-lock."
- (cond
- ((or font-pov-is-Emacs20 font-pov-is-Emacs21 font-pov-is-Emacs22)
- ;; Tell Font Lock about the support.
- (make-local-variable 'font-lock-defaults))
- ((or font-pov-is-XEmacs19 font-pov-is-XEmacs20)
- ;; Cool patch from Christoph Wedler...
- (let (instance)
- (mapcar (function
- (lambda (property)
- (setq instance
- (face-property-instance 'font-pov-number-face property nil 0 t))
- (if (numberp instance)
- (setq instance
- (face-property-instance 'default property nil 0)))
- ;(or (numberp instance)
- ; (set-face-property 'font-lock-string-face property
- ; instance (current-buffer)))))
- ))
- (built-in-face-specifiers))))
- (font-pov-is-Emacs19
- (make-local-variable 'font-lock-defaults))))
- (cond
- ((or font-pov-is-Emacs20 font-pov-is-XEmacs20-2 font-pov-is-Emacs21 font-pov-is-Emacs22)
- (defface font-pov-object-face
- '((((class grayscale) (background light)) (:foreground "DimGray" :bold t))
- (((class grayscale) (background dark)) (:foreground "LightGray" :bold t))
- (((class color) (background light)) (:foreground "DarkOliveGreen" :bold t))
- (((class color) (background dark)) (:foreground "White" :bold t ))
- (t (:bold t)))
- "Font Lock mode face used for objects."
- :group 'font-pov-faces)
- (defface font-pov-directive-face
- '((((class grayscale) (background light)) (:foreground "DimGray"))
- (((class grayscale) (background dark)) (:foreground "LightGray"))
- (((class color) (background light)) (:foreground "DarkRed"))
- (((class color) (background dark)) (:foreground "lightgreen"))
- (t (:italic t)))
- "Font Lock mode face used to highlight PoV directives."
- :group 'font-pov-faces)
- (defface font-pov-number-face
- '((((class grayscale) (background light))(:foreground "DimGray" :underline t))
- (((class grayscale) (background dark)) (:foreground "LightGray" :underline t))
- (((class color) (background light)) (:foreground "SaddleBrown"))
- (((class color) (background dark)) (:foreground "wheat"))
- (t (:underline t)))
- "Font Lock mode face used to highlight numbers in PoV."
- :group 'font-pov-faces)
- (defface font-pov-variable-face
- '((((class grayscale) (background light)) (:foreground "DimGray"))
- (((class grayscale) (background dark)) (:foreground "LightGray"))
- (((class color) (background light)) (:foreground "ForestGreen"))
- (((class color) (background dark)) (:foreground "gray80"))
- )
- "Font Lock mode face used to highlight variabledeclarations in PoV."
- :group 'font-pov-faces)
- (defface font-pov-csg-face
- '((((class grayscale) (background light)) (:foreground "DimGray"))
- (((class grayscale) (background dark)) (:foreground "LightGray"))
- (((class color) (background light)) (:foreground "Blue"))
- (((class color) (background dark)) (:foreground "red"))
- )
- "Font Lock mode face used to highlight CSGs in PoV."
- :group 'font-pov-faces)
- ;; -- C.H. --
- (defface font-pov-macro-name-face
- '((((class grayscale) (background light)) (:foreground "DimGray" :bold t))
- (((class grayscale) (background dark)) (:foreground "LightGray" :bold t))
- (((class color) (background light)) (:foreground "Blue2" :bold t))
- (((class color) (background dark)) (:foreground "gray80" :bold t))
- )
- "Font Lock mode face used to highlight macro declarations in PoV."
- :group 'font-pov-faces)
- (defface font-pov-keyword-face
- '((((class grayscale) (background light)) (:foreground "DimGray"))
- (((class grayscale) (background dark)) (:foreground "LightGray"))
- (((class color) (background light)) (:foreground "Blue4"))
- (((class color) (background dark)) (:foreground "Blue"))
- )
- "Font Lock mode face used to highlight general keywords in PoV."
- :group 'font-pov-faces)
- ;; -- end C.H. --
- (defface font-pov-operator-face
- '((((class grayscale)(background light)) (:foreground "DimGray" :bold t))
- (((class grayscale)(background dark)) (:foreground "LightGray" :bold t))
- (((class color)(background light)) (:foreground "Limegreen" :bold t ))
- (((class color)(background dark)) (:foreground "Limegreen" :bold t ))
- (t (:bold t)))
- "Font Lock mode face used to highlight operators in PoV."
- :group 'font-pov-faces))
- (font-pov-is-Emacs19
- (unless (assq 'font-pov-variable-face font-lock-face-attributes)
- (cond
- ;; FIXME: Add better conditions for grayscale.
- ((memq font-lock-display-type '(mono monochrome grayscale greyscale
- grayshade greyshade))
- (setq font-lock-face-attributes
- (append
- font-lock-face-attributes
- (list '(font-pov-variable-face nil nil t nil nil)
- '(font-pov-macro-name-face nil nil t nil nil) ;; C.H.
- '(font-pov-keyword-face nil nil nil t nil) ;; C.H.
- '(font-pov-object-face nil nil nil t nil)
- '(font-pov-number-face nil nil nil nil t)
- (list
- 'font-pov-operator-face
- (cdr (assq 'background-color (frame-parameters)))
- (cdr (assq 'foreground-color (frame-parameters)))
- nil nil nil)))))
- ((eq font-lock-background-mode 'light) ; light color background
- (setq font-lock-face-attributes
- (append
- font-lock-face-attributes
- ;;;FIXME: These won't follow font-lock-type-face's changes.
- ;;; Should I change to a (copy-face) scheme?
- '((font-pov-variable-face "DarkOliveGreen" nil t nil nil)
- (font-pov-macro-name-face "DarkOliveGreen" nil t nil nil) ;; C.H.
- (font-pov-keyword-face "grey50") ;; C.H.
- (font-pov-number-face "DarkOliveGreen" nil nil t nil)
- (font-pov-object-face "grey50")
- (font-pov-directive-face "red" nil t nil nil)))))
- (t ; dark color background
- (setq font-lock-face-attributes
- (append
- font-lock-face-attributes
- '((font-pov-varible-face "OliveDrab" nil t nil nil)
- (font-pov-macro-name-face "OliveDrab" nil t nil nil) ;; C.H.
- (font-pov-keyword-face "grey60") ;; C.H.
- (font-pov-number-face "OliveDrab" nil nil t nil)
- ;; good are > LightSeaGreen, LightCoral, coral, orchid, orange
- (font-pov-object-face "grey60")
- (font-pov-directive-face "red" nil t nil nil))))))))
- (t
- ;;; XEmacs < version 20.2
- (make-face 'font-pov-variable-face "Face to use for PoV variables.")
- (make-face 'font-pov-macro-name-face "Face to use for PoV macros.") ;; C.H.
- (make-face 'font-pov-keyword-face "Face to use for PoV keywords.") ;; C.H.
- (make-face 'font-pov-directive-face "Face to use for PoV directives.")
- (make-face 'font-pov-number-face "Face to use for PoV numbers.")
- (make-face 'font-pov-operator-face "Face to use for PoV operators.")
- (make-face 'font-pov-csg-face "Face to use for PoV csg.")
- (make-face 'font-pov-object-face "Face to use for PoV objects.")
- (make-face-bold 'font-pov-object-face)
- ;; XEmacs uses a tag-list thingy to determine if we are using color
- ;; or mono (and I assume a dark background).
- (set-face-foreground 'font-pov-object-face "green4" 'global nil 'append)
- (set-face-foreground 'font-pov-number-face "green" 'global nil 'append)
- (set-face-foreground 'font-pov-variable-face "red" 'global nil 'append)
- (set-face-foreground 'font-pov-macro-name-face "blue2" 'global nil 'append) ;; C.H.
- (set-face-foreground 'font-pov-keyword-face "blue4" 'global nil 'append) ;; C.H.
- ))
- (font-pov-setup) ;; Setup and register the fonts...
- (defun pov-make-tabs (stop)
- (and (< stop 132) (cons stop (pov-make-tabs (+ stop pov-tab-width)))))
- (defconst pov-tab-stop-list (pov-make-tabs pov-tab-width)
- "Tab stop list for PoV mode")
- (defvar pov-mode-map nil
- "Keymap used in PoV mode buffers")
- (defvar pov-mode-syntax-table nil
- "PoV mode syntax table")
- (defconst pov-comment-start-regexp "//\\|/\\*"
- "Dual comment value for `comment-start-regexp'.")
- (defvar pov-comment-syntax-string ". 124b"
- "PoV hack to handle Emacs/XEmacs foo")
- (defvar pov-begin-re "\\<#\\(if\\(n?def\\)?\\|case\\|range\\|switch\\|while\\)\\>")
- (defvar pov-end-re "\\<#break\\|#end\\>")
- (defvar pov-else-re "\\<#else\\>")
- (defvar pov-begin-end-re (concat
- pov-begin-re
- "\\|"
- pov-end-re
- "\\|"
- pov-else-re))
- (defun pov-setup-syntax-table nil
- (if (or (string-match "Lucid" emacs-version)
- (string-match "XEmacs" emacs-version))
- (setq pov-comment-syntax-string ". 1456"))
- (if pov-mode-syntax-table
- ()
- (setq pov-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?_ "w" pov-mode-syntax-table)
- (modify-syntax-entry ?# "w" pov-mode-syntax-table)
- (modify-syntax-entry ?/ pov-comment-syntax-string pov-mode-syntax-table)
- (modify-syntax-entry ?* ". 23" pov-mode-syntax-table)
- (modify-syntax-entry ?\n "> b" pov-mode-syntax-table)
- (set-syntax-table pov-mode-syntax-table)))
- ;; -- C.H. --
- (defvar pov-all-keyword-matcher
- (eval-when-compile
- (concat "\\<\\("
- (regexp-opt '("aa_level" "aa_threshold" "abs" "absorption" "accuracy" "acos" "acosh" "adaptive"
- "adc_bailout" "agate" "agate_turb" "all" "all_intersections" "alpha" "altitude"
- "always_sample" "ambient" "ambient_light" "angle" "aperture" "append" "arc_angle"
- "area_light" "array" "asc" "ascii" "asin" "asinh" "assumed_gamma" "atan" "atan2"
- "atanh" "autostop" "average"
- "b_spline" "background" "bezier_spline" "bicubic_patch" "black_hole" "blob" "blue"
- "blur_samples" "bounded_by" "box" "boxed" "bozo" "break" "brick" "brick_size"
- "brightness" "brilliance" "bump_map" "bump_size" "bumps"
- "camera" "case" "caustics" "ceil" "cells" "charset" "checker" "chr" "circular"
- "clipped_by" "clock" "clock_delta" "clock_on" "collect" "color" "color_map"
- "colour" "colour_map" "component" "composite" "concat" "cone" "confidence"
- "conic_sweep" "conserve_energy" "contained_by" "control0" "control1" "coords"
- "cos" "cosh" "count" "crackle" "crand" "cube" "cubic" "cubic_spline" "cubic_wave"
- "cutaway_textures" "cylinder" "cylindrical" "debug" "declare" "default" "defined"
- "degrees" "density" "density_file" "density_map" "dents" "df3" "difference"
- "diffuse" "dimension_size" "dimensions" "direction" "disc" "dispersion"
- "dispersion_samples" "dist_exp" "distance" "div" "double_illuminate" "eccentricity"
- "else" "emission" "end" "error" "error_bound" "evaluate" "exp" "expand_thresholds"
- "exponent" "exterior" "extinction"
- "face_indices" "facets" "fade_color" "fade_colour" "fade_distance" "fade_power"
- "falloff" "falloff_angle" "false" "fclose" "file_exists" "filter" "final_clock"
- "final_frame" "finish" "fisheye" "flatness" "flip" "floor" "focal_point" "fog"
- "fog_alt" "fog_offset" "fog_type" "fopen" "form" "frame_number" "frequency"
- "fresnel" "function" "gather" "gif" "global_lights" "global_settings" "gradient"
- "granite" "gray" "gray_threshold" "green"
- "height_field" "hexagon" "hf_gray_16" "hierarchy" "hypercomplex" "hollow"
- "if" "ifdef" "iff" "ifndef" "image_height" "image_map" "image_pattern" "image_width"
- "include" "initial_clock" "initial_frame" "inside" "int" "interior" "interior_texture"
- "internal" "interpolate" "intersection" "intervals" "inverse" "ior" "irid"
- "irid_wavelength" "isosurface"
- "jitter" "jpeg" "julia" "julia_fractal"
- "lambda" "lathe" "leopard" "light_group" "light_source" "linear_spline" "linear_sweep"
- "ln" "load_file" "local" "location" "log" "look_at" "looks_like" "low_error_factor"
- "macro" "magnet" "major_radius" "mandel" "map_type" "marble" "material" "material_map"
- "matrix" "max" "max_extent" "max_gradient" "max_intersections" "max_iteration"
- "max_sample" "max_trace" "max_trace_level" "media" "media_attenuation"
- "media_interaction" "merge" "mesh" "mesh2" "metallic" "method" "metric" "min"
- "min_extent" "minimum_reuse" "mod" "mortar"
- "natural_spline" "nearest_count" "no" "no_bump_scale" "no_image" "no_reflection"
- "no_shadow" "noise_generator" "normal" "normal_indices" "normal_map" "normal_vectors"
- "number_of_waves"
- "object" "octaves" "off" "offset" "omega" "omnimax" "on" "once" "onion" "open"
- "orient" "orientation" "orthographic"
- "panoramic" "parallel" "parametric" "pass_through" "pattern" "perspective" "pgm"
- "phase" "phong" "phong_size" "photons" "pi" "pigment" "pigment_map" "pigment_pattern"
- "planar" "plane" "png" "point_at" "poly" "poly_wave" "polygon" "pot" "pow" "ppm"
- "precision" "precompute" "pretrace_end" "pretrace_start" "prism" "projected_through"
- "pwr"
- "quadratic_spline" "quadric" "quartic" "quaternion" "quick_color" "quick_colour"
- "quilted"
- "radial" "radians" "radiosity" "radius" "rainbow" "ramp_wave" "rand" "range"
- "range_divider" "ratio" "read" "reciprocal" "recursion_limit" "red" "reflection"
- "reflection_exponent" "refraction" "render" "repeat" "rgb" "rgbf" "rgbft" "rgbt"
- "right" "ripples" "rotate" "roughness"
- "samples" "save_file" "scale" "scallop_wave" "scattering" "seed" "select" "shadowless"
- "sin" "sine_wave" "sinh" "size" "sky" "sky_sphere" "slice" "slope" "slope_map"
- "smooth" "smooth_triangle" "solid" "sor" "spacing" "specular" "sphere" "sphere_sweep"
- "spherical" "spiral1" "spiral2" "spline" "split_union" "spotlight" "spotted" "sqr"
- "sqrt" "statistics" "str" "strcmp" "strength" "strlen" "strlwr" "strupr" "sturm"
- "substr" "superellipsoid" "switch" "sys"
- "t" "tan" "tanh" "target" "text" "texture" "texture_list" "texture_map" "tga"
- "thickness" "threshold" "tiff" "tightness" "tile2" "tiles" "tolerance" "toroidal"
- "torus" "trace" "transform" "translate" "transmit" "triangle" "triangle_wave" "true"
- "ttf" "turb_depth" "turbulence" "type"
- "u" "u_steps" "ultra_wide_angle" "undef" "union" "up" "use_alpha" "use_color"
- "use_colour" "use_index" "utf8" "uv_indices" "uv_mapping" "uv_vectors"
- "v" "v_steps" "val" "variance" "vaxis_rotate" "vcross" "vdot" "version"
- "vertex_vectors" "vlength" "vnormalize" "vrotate" "vstr" "vturbulence" "warning"
- "warp" "water_level" "waves" "while" "width" "wood" "wrinkles" "write"
- "x"
- "y" "yes"
- "z") t)
- "\\)\\>")))
- (defvar pov-all-directives-matcher
- (eval-when-compile
- (concat "\\<\\("
- (regexp-opt '("#break" "#case" "#debug" "#declare" "#default" "#else" "#end" "#error" "#fclose"
- "#fopen" "#if" "#ifdef" "#ifndef" "#include" "#local" "#macro" "#range" "#read"
- "#render" "#statistics" "#switch" "#undef" "#version" "#warning" "#while" "#write") t)
- "\\)\\>")))
- (defvar pov-all-objects-matcher
- (eval-when-compile
- (concat "\\<\\("
- (regexp-opt '("background" "bicubic_patch" "blob" "box" "camera" "cone" "cubic" "cylinder" "disc"
- "fog" "height_field" "isosurface" "julia_fractal" "lathe" "light_group" "light_source"
- "mesh" "mesh2" "object" "parametric" "plane" "poly" "polygon" "prism" "rainbow"
- "sky_sphere" "smooth_triangle" "sor" "sphere" "sphere_sweep" "superellipsoid" "text" "torus"
- "triangle" "quadric" "quartic") t)
- "\\)\\>")))
- (defvar pov-font-lock-keywords
- (list
- ;; highlight variable names after '#declare/#local'
- (list "\\<\\(#declare\\|#local\\)\\>[ \t\n]*\\(\\sw+\\)" '(2 font-pov-variable-face nil t))
- ;; highlight csg-keywords
- (list "\\<\\(difference\\|intersection\\|merge\\|union\\)\\>" '(1 font-pov-csg-face))
- ;; highlight variable names after '#macro'
- (list "\\<\\(#macro\\)\\>[ \t\n]*\\(\\sw+\\)" '(2 font-pov-macro-name-face nil t))
- ;; highlight numbers with type-face
- (list "\\(\\<\\([0-9]*\\.[0-9]+\\|[0-9]+\\)\\|\\.[0-9]+\\)\\([eE][+\\-]?[0-9]+\\)?\\>"
- '(1 font-pov-number-face))
- ;; highlight operators keywords
- (list "\\([\\-\\+\\|\\^=&!?:/\\>\\<\\*]+\\)" '(1 font-pov-operator-face))
- ;; highlight directives
- (list pov-all-directives-matcher '(1 font-pov-directive-face))
- ;; highlight objects
- (list pov-all-objects-matcher '(1 font-pov-object-face))
- ;; highlight general keywords
- (list pov-all-keyword-matcher '(1 font-pov-keyword-face))
- )
- "Expressions to highlight in PoV mode."
- )
- ;; -- end C.H --
- (defun pov-mode nil
- "Major mode for editing PoV files. (Version 2.11)
- In this mode, TAB and \\[indent-region] attempt to indent code
- based on the position of {} pairs and #-type directives. The variable
- pov-indent-level controls the amount of indentation used inside
- arrays and begin/end pairs. The variable pov-indent-under-declare
- determines indent level when you have something like this:
- #declare foo =
- some_object {
- This mode also provides PoVray keyword fontification using font-lock.
- Set pov-fontify-insanely to nil to disable (recommended for large
- files!).
- \\[pov-complete-word] runs pov-complete-word, which attempts to complete the
- current word based on point location.
- \\[pov-keyword-help] looks up a povray keyword in the povray documentation.
- \\[pov-command-query] will render or display the current file.
- \\{pov-mode-map}
- \\[pov-mode] calls the value of the variable pov-mode-hook with no args, if that value is non-nil.
- "
- (interactive)
- (kill-all-local-variables)
- (use-local-map pov-mode-map)
- (pov-setup-syntax-table)
- (make-local-variable 'font-lock-keywords)
- (make-local-variable 'comment-start)
- (make-local-variable 'comment-start-skip)
- (make-local-variable 'comment-end)
- (make-local-variable 'comment-multi-line)
- (make-local-variable 'comment-column)
- (make-local-variable 'indent-line-function)
- (make-local-variable 'tab-stop-list)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-keywords pov-font-lock-keywords)
- (setq font-lock-defaults '(pov-font-lock-keywords))
- (if (and (boundp 'running-xemacs) running-xemacs)
- (pov-toolbar))
- (if pov-imenu-in-menu
- (pov-helper-imenu-setup))
- ;; Create and show the insert menu
- (pov-im-make-menu)
- (easy-menu-add pov-im-menu)
- (set-syntax-table pov-mode-syntax-table)
- (setq comment-start "// "
- comment-start-skip "/\\*+ *\\|// *"
- comment-end ""
- comment-multi-line nil
- comment-column 60
- indent-line-function 'pov-indent-line
- tab-stop-list pov-tab-stop-list)
- (setq mode-name "PoV")
- (setq major-mode 'pov-mode)
- (run-hooks 'pov-mode-hook)
- )
- (defun pov-tab ()
- "Command assigned to the TAB key in PoV mode."
- (interactive)
- (if (save-excursion (skip-chars-backward " \t") (bolp))
- (pov-indent-line)
- (save-excursion
- (pov-indent-line))))
- (defun pov-indent-line nil
- "Indents a line of PoV code."
- (interactive)
- (beginning-of-line)
- (delete-horizontal-space)
- (if (pov-top-level-p)
- (pov-indent-top-level)
- (if (not (pov-top-level-p))
- (if (pov-in-star-comment-p)
- (indent-to '2)
- (if (and (< (point) (point-max))
- (or
- (eq ?\) (char-syntax (char-after (point))))
- (or
- (looking-at "\\<#\\(end\\|break\\)\\>")
- (and (looking-at "\\<#else\\>")
- (not (pov-in-switch-p 0))))))
- (pov-indent-close) ; indent close-delimiter
- (pov-indent-in-block)))))) ; indent line after open delimiter
- (defun pov-newline nil
- "Terminate line and indent next line."
- (interactive)
- (newline)
- (pov-indent-line))
- (defun pov-in-star-comment-p nil
- "Return true if in a star comment"
- (let ((state
- (save-excursion
- (parse-partial-sexp (point-min) (point)))))
- (nth 4 state)))
- (defun pov-open nil
- (interactive)
- (insert last-command-char))
- (defun pov-close nil
- "Inserts and indents a close delimiter."
- (interactive)
- (insert last-command-char)
- (backward-char 1)
- (pov-indent-close)
- (forward-char 1)
- (blink-matching-open))
- (defun pov-indent-close nil
- "Internal function to indent a line containing a close delimiter."
- (if (save-excursion (skip-chars-backward " \t") (bolp))
- (let (x (oldpoint (point)))
- (if (looking-at "#end\\|#else\\|#break")
- (progn
- (goto-char (pov-find-begin 0))
- (if (and (looking-at "#else")
- (pov-in-switch-p 0))
- (goto-char (pov-find-begin 0))))
- (forward-char) (backward-sexp)) ;XXX
- (if (and (eq 1 (count-lines (point) oldpoint))
- (> 1 (- oldpoint (point))))
- (goto-char oldpoint)
- (beginning-of-line)
- (skip-chars-forward " \t")
- (setq x (current-column))
- (goto-char oldpoint)
- (delete-horizontal-space)
- (indent-to x)))))
- (defun pov-indent-in-block nil
- "Indent a line which does not open or close a block."
- (let ((goal (pov-block-start)))
- (setq goal (save-excursion
- (goto-char goal)
- (back-to-indentation)
- (if (bolp)
- pov-indent-level
- (back-to-indentation)
- (+ (current-column) pov-indent-level))))
- (indent-to goal)))
- (defun pov-indent-top-level nil
- (if (save-excursion
- (forward-line -1)
- (looking-at "\\<#declare[ \t]+[0-9a-zA-Z_]+[ \t]*=[ \t]*$"))
- (indent-to pov-indent-under-declare)))
- ;;; returns nil if at top-level, or char pos of beginning of current block
- (defun pov-block-start nil
- "Returns the character position of the character following the nearest
- enclosing `{' or `begin' keyword."
- (save-excursion
- (let (open (skip 0))
- (setq open (condition-case nil
- (save-excursion
- (backward-up-list 1)
- (1+ (point)))
- (error nil)))
- (pov-find-begin open))))
- (defun pov-find-begin (start)
- "Search backwards from point to START for enclosing `begin' and returns the
- character number of the character following `begin' or START if not found."
- (save-excursion
- (let ((depth 1) match)
- (while (and (> depth 0)
- (pov-re-search-backward pov-begin-end-re start t))
- (setq depth (if (looking-at pov-end-re)
- (if (and (looking-at "#end")
- (pov-in-switch-p start))
- (progn
- (pov-re-search-backward "\\<#switch\\>" start t)
- depth)
- (+ 1 depth))
- (if (looking-at "\\<#else\\>")
- (if (pov-in-switch-p start)
- (1- depth)
- depth)
- (1- depth)))))
- (if (not (eq 0 depth))
- start
- (point)))))
- (defun pov-in-switch-p (start)
- "Return t if one level under a switch."
- (save-excursion
- (if (looking-at "\\<#end\\>")
- (pov-re-search-backward pov-begin-end-re start t))
- (beginning-of-line)
- (pov-re-search-backward pov-begin-end-re start t)
- (if (looking-at "\\<#else\\>>") (forward-word -1))
- (while (looking-at "\\<#break\\>")
- (progn
- (pov-re-search-backward "\\<#case\\|#range\\>" start t)
- (pov-re-search-backward pov-begin-end-re start t)))
- (pov-re-search-backward pov-begin-end-re start t)
- (looking-at "\\<#switch\\>")))
- (defun pov-top-level-p nil
- "Awful test to see whether we are inside some sort of PoVray block."
- (and (condition-case nil
- (not (scan-lists (point) -1 1))
- (error t))
- (not (pov-find-begin nil))))
- (defsubst pov-re-search-backward (REGEXP BOUND NOERROR)
- "Like re-search-backward, but skips over matches in comments or strings"
- (set-match-data '(nil nil))
- (while (and
- (re-search-backward REGEXP BOUND NOERROR)
- (pov-skip-backward-comment-or-string)
- (not (set-match-data '(nil nil))))
- ())
- (match-end 0))
- (defun pov-autoindent-endblock nil
- "Hack to automatically reindent end, break, and else."
- (interactive)
- (self-insert-command 1)
- (save-excursion
- (forward-word -1)
- (if (looking-at "\\<#else\\|#end\\|#break\\>")
- (pov-indent-line))))
- ; Taken from verilog-mode.el
- (defun pov-skip-backward-comment-or-string ()
- "Return true if in a string or comment"
- (let ((state
- (save-excursion
- (parse-partial-sexp (point-min) (point)))))
- (cond
- ((nth 3 state) ;Inside string
- (search-backward "\"")
- t)
- ((nth 7 state) ;Inside // comment
- (search-backward "//")
- t)
- ((nth 4 state) ;Inside /* */ comment
- (search-backward "/*")
- t)
- (t
- nil))))
- ; *******************
- ; *** Completions ***
- ; *******************
- ;; -------------------------------------------------------------------
- ;; C.H.: adapted completion to POV-Ray 3.5 syntax to some extent
- ;; -------------------------------------------------------------------
- (defvar pov-completion-str nil)
- (defvar pov-completion-all nil)
- (defvar pov-completion-pred nil)
- ;(defvar pov-completion-buffer-to-use nil)
- (defvar pov-completion-flag nil)
- (defvar pov-global-keywords
- '("#break" "#case" "#debug" "#declare" "#default" "#else" "#end" "#fclose" "#fopen" "#include" "#local"
- "#macro" "#read" "#render" "#statistics" "#switch" "#undef" "#version" "#warning" "#write"))
- (defvar pov-top-level-keywords
- '("global_settings" "camera" "light_source" "light_group" "media" "background" "sky_sphere" "photons" "rainbow"))
- (defvar pov-csg-scope-re
- "\\<inverse\\|union\\|intersection\\|difference\\|merge\\>")
- (defvar pov-solid-primitive-keywords
- '("blob" "box" "cone" "cylinder" "height_field" "julia_fractal" "lathe" "object" "prism" "sphere"
- "sphere_sweep" "superellipsoid" "sor" "text" "torus" "isosurface" "parametric"))
- (defvar pov-blob-keywords
- '("threshold" "cylinder" "sphere" "component" "hierarchy" "sturm"))
- (defvar pov-heightfield-keywords
- '("hierarchy" "smooth" "water_level"))
- (defvar pob-isosurface-keywords
- '("accuracy" "all_intersections" "contained_by" "evaluate" "function" "max_gradient" "max_trace" "method"
- "open" "threshold"))
- (defvar pov-juliafractal-keywords
- '("max_iteration" "precision" "slice" "quaternion" "hypercomplex" "slice"))
- (defvar pov-prism-keywords
- '("linear_sweep" "conic_sweep" "linear_spline" "quadratic_spline" "cubic_spline" "bezier_spline" "sturm"))
- (defvar pov-patch-primitive-keywords
- '("bicubic_patch" "disc" "smooth_triangle" "triangle" "polygon" "mesh" "mesh2"))
- (defvar pov-bicubic-keywords
- '("type" "flatness" "u_steps" "v_steps"))
- ;defvar pov-bezier-keywords
- ; '("accuracy" "rational" "trimmed_by"))
- (defvar pov-infinite-solid-keywords
- '("plane" "cubic" "poly" "quadric" "quartic"))
- (defvar pov-csg-keywords
- '("inverse" "union" "intersection" "difference" "merge" "split_union"))
- (defvar pov-light-source-keywords
- '("color" "spotlight" "point_at" "radius" "falloff" "tightness" "area_light" "adaptive" "jitter" "looks_like"
- "shadowless" "cylinder" "fade_distance" "fade_power" "media_attenuation" "media_interaction" "rgb"
- "circular" "orient" "groups" "parallel"))
- (defvar pov-object-modifier-keywords
- '("clipped_by" "bounded_by" "hollow" "no_shadow" "no_reflection" "no_image" "interior_texture"))
- (defvar pov-transformation-keywords
- '("rotate" "scale" "translate" "matrix" "transform"))
- (defvar pov-camera-keywords
- '("perspective" "orthographic" "fisheye" "ultra_wide_angle" "omnimax" "panoramic" "cylinder" "spherical"
- "location" "look_at" "right" "up" "direction" "sky" "sphere" "spherical_camera" "h_angle" "v_angle" "angle"
- "blur_samples" "aperture" "focal_point" "normal" "rotate" "translate"))
- (defvar pov-texture-keywords
- '("pigment" "normal" "finish" "halo" "texture_map" "material_map" "boxed" "planar" "cylindrical" "spherical"))
- ;(defvar pov-pigment-keywords
- ; '("colour" "boxed" "brick" "checker" "cylindrical" "hexagon" "color_map" "gradient" "pigment_map" "pigment" "planar" "spherical" "image_map" "quick_color" "rgb"))
- (defvar pov-pigment-keywords
- '("color" "colour" "colour_map" "color_map" "pigment_map" "pigment" "image_map" "quick_color"))
- (defvar pov-normal-keywords
- '("slope_map" "normal_map" "bump_map" "bump_size" "boxed" "cylindrical" "planar" "spherical"))
- (defvar pov-finish-keywords
- '("ambient" "diffuse" "brilliance" "phong" "phong_size" "specular" "roughness" "metallic" "reflection" "irid"
- "crand"))
- ;; "refraction" "ior" "caustics" "fade_distance" "fade_power" ;;povray3.0
- (defvar pov-reflection-keywords
- '("fresnel" "falloff" "exponent" "metallic" ))
- (defvar pov-irid-keywords
- '("thickness" "turbulence"))
- ;(defvar pov-pattern-keywords
- ; '("agate" "average" "boxed" "bozo" "brick" "bumps" "checker" "color" "crackle" "cylindrical" "density_file" "dents" "gradient" "granite" "hexagon" "leopard" "mandel" "marble" "onion" "planar" "pattern1" "pattern2" "pattern3" "quilted" "radial" "ripples" "spherical" "spiral1" "spiral2" "spotted" "waves" "wood" "wrinkles" "image_map" "bump_map" ))
- (defvar pov-pattern-keywords
- '("agate" "average" "boxed" "bozo" "brick" "bumps" "cells" "checker" "crackle" "cylindrical" "density_file"
- "dents" "julia" "mandel" "magnet" "function" "gradient" "granite" "hexagon" "image_pattern" "leopard"
- "marble" "object" "onion" "pigment_pattern" "planar" "quilted" "radial" "ripples" "slope" "spherical"
- "spiral1" "spiral2" "spotted" "wood" "waves" "wrinkles" "frequency" "phase" "ramp_wave" "triangle_wave"
- "sine_wave" "scallop_wave" "cubic_wave" "poly_wave" "noise_generator" "turbulence" "octaves" "omega"
- "lambda" "warp"))
- (defvar pov-media-keywords
- '("intervals" "samples" "confidence" "variance" "ratio" "absorption" "emission" "scattering" "density"
- "color_map" "density_map" "light_group" "sample_method" "aa_level" "aa_threshold" "jitter" "method"))
- (defvar pov-interior-keywords
- '("ior" "caustics" "fade_distance" "fade_power" "media" "dispersion" "dispersion_samples" "fade_color"))
- (defvar pov-texture-keywords
- '("pigment" "normal" "finish" "texture_map" "material_map"))
- (defvar pov-material-keywords
- '("texture" "interior"))
- (defvar pov-warp-keywords
- '("repeat" "black_hole" "turbulence" "cylindrical" "spherical" "toroidal" "planar" "orientation" "dist_exp"
- "major_radius" "offset" "flip" "strength" "falloff" "inverse"))
- (defvar pov-density-keyword
- '("colour" "colour_map" "boxed" "planar" "cylindrical" "spherical"))
- (defvar pov-fog-keywords
- '("fog_type" "distance" "color" "turbulence" "turb_depth" "omega" "lambda" "octaves" "fog_offset" "fog_alt"
- "up"))
- (defvar pov-rainbow-keywords
- '("direction" "angle" "width" "distance" "jitter" "up" "arc_angle" "falloff_angle"))
- (defvar pov-global-settings-keywords
- '("adc_bailout" "ambient_light" "assumed_gamma" "charset" "hf_gray_16" "irid_wavelength" "max_intersections"
- "max_trace_level" "number_of_waves" "radiosity" "reflection_samples" "photons" "noise_generator"))
- (defvar pov-radiosity-keywords
- '("adc_bailout" "always_sample" "brightness" "count" "distance_maximum" "error_bound" "gray_threshold"
- "low_error_factor" "minimum_reuse" "nearest_count" "recursion_limit" "max_sample" "media" "normal"
- "pretrace_end" "pretrace_start" "recursion_limit" "save_file"))
- (defvar pov-object-keywords
- '("texture" "pigment" "finish" "interior" "normal" "no_shadow"))
- ;; Povray3.0
- ;;(defvar pov-atmosphere-keywords
- ;; '("type" "distance" "scattering" "eccentricity" "samples" "jitter" "aa_threshold" "aa_level" "colour" "color"))
- ;AS: halo is no longer existent in pov 3.1 so we won't need that
- ;(defvar pov-halo-keywords
- ; '("attenuating" "emitting" "glowing" "dust" "constant" "linear" "cubic" "poly" "planar_mapping" "spherical_mapping" "cylindrical_mapping" "box_mapping" "dust_type" "eccentricity" "max_value" "exponent" "samples" "aa_level" "aa_threshold" "jitter" "turbulence" "octaves" "omega" "lambda" "colour_map" "frequency" "phase" "scale" "rotate" "translate"))
- ;;AS
- (defvar pov-keyword-completion-alist
- (mapcar (function
- (lambda (item) (list item item)))
- (append
- pov-global-keywords
- pov-top-level-keywords
- pov-solid-primitive-keywords
- pov-blob-keywords
- pov-heightfield-keywords
- pov-juliafractal-keywords
- pov-prism-keywords
- pov-patch-primitive-keywords
- pov-bicubic-keywords
- pov-infinite-solid-keywords
- pov-csg-keywords
- pov-light-source-keywords
- pov-object-modifier-keywords
- pov-transformation-keywords
- pov-camera-keywords
- pov-texture-keywords
- pov-pigment-keywords
- pov-normal-keywords
- pov-finish-keywords
- pov-reflection-keywords
- pov-irid-keywords
- pov-pattern-keywords
- pov-pattern-keywords
- pov-media-keywords
- pov-interior-keywords
- pov-texture-keywords
- pov-material-keywords
- pov-warp-keywords
- pov-fog-keywords
- pov-rainbow-keywords
- pov-global-settings-keywords
- pov-radiosity-keywords
- pov-object-keywords
- )))
- ;pov-media-keywords
- ; pov-bicubic-keywords
- ; pov-normal-keywords
- ; pov-blob-keywords
- ; pov-object-keywords
- ; pov-camera-keywords
- ; pov-pattern-keywords
- ; pov-csg-keywords
- ; pov-pigment-keywords
- ; pov-density-keyword
- ; pov-prism-keywords
- ; pov-finish-keywords
- ; pov-radiosity-keywords
- ; pov-fog-keywords
- ; pov-texture-keywords
- ; pov-heightfield-keywords
- ; pov-global-keywords)))
- ; pov-atmosphere-keywords
- ;pov-halo-keywords
- (defun pov-string-diff (str1 str2)
- "Return index of first letter where STR1 and STR2 differs."
- (catch 'done
- (let ((diff 0))
- (while t
- (if (or (> (1+ diff) (length str1))
- (> (1+ diff) (length str2)))
- (throw 'done diff))
- (or (equal (aref str1 diff) (aref str2 diff))
- (throw 'done diff))
- (setq diff (1+ diff))))))
- (defun pov-get-scope nil
- "Return the scope of the POV source at point"
- (interactive)
- (save-excursion
- (if (not (pov-top-level-p))
- (progn
- (backward-up-list 1)
- (forward-word -1)
- (cond
- ((looking-at "camera")
- (setq pov-completion-list pov-camera-keywords))
- ((looking-at "texture")
- (setq pov-completion-list (append pov-texture-keywords pov-pattern-keywords)))
- ((looking-at "material")
- (setq pov-completion-list (append pov-material-keywords pov-pattern-keywords)))
- ((looking-at "pigment")
- (setq pov-completion-list (append pov-pigment-keywords pov-pattern-keywords)))
- ((looking-at "normal")
- (setq pov-completion-list (append pov-normal-keywords pov-pattern-keywords)))
- ((looking-at "density")
- (setq pov-completion-list (append pov-density-keywords pov-pattern-keywords)))
- ((looking-at "finish")
- (setq pov-completion-list pov-finish-keywords))
- ((looking-at "warp")
- (setq pov-completion-list pov-warp-keywords))
- ((looking-at "finish")
- (setq pov-completion-list pov-finish-keywords))
- ((looking-at "reflection")
- (setq pov-completion-list pov-reflection-keywords))
- ((looking-at "irid")
- (setq pov-completion-list pov-irid-keywords))
- ((looking-at "blob")
- (setq pov-completion-list pov-blob-keywords))
- ((looking-at "isosurface")
- (setq pov-completion-list pov-isosurface-keywords))
- ((looking-at "heightfield")
- (setq pov-completion-list pov-heightfield-keywords))
- ((looking-at "prism")
- (setq pov-completion-list pov-prism-keywords))
- ((looking-at "julia_fractal")
- (setq pov-completion-list pov-juliafractal-keywords))
- ((looking-at "bicubic")
- (setq pov-completion-list pov-bicubic-keywords))
- ((looking-at "bezier")
- (setq pov-completion-list pov-bezier-keywords))
- ((looking-at "trimmed_by")
- (setq pov-completion-list pov-bezier-keywords))
- ((looking-at "light_source")
- (setq pov-completion-list pov-light-source-keywords))
- ((looking-at "interior")
- (setq pov-completion-list pov-interior-keywords))
- ((looking-at "media")
- (setq pov-completion-list pov-media-keywords))
- ((looking-at "fog")
- (setq pov-completion-list pov-fog-keywords))
- ((looking-at "global_settings")
- (setq pov-completion-list pov-global-settings-keywords ))
- ((looking-at "radiosity")
- (setq pov-completion-list pov-radiosity-keywords))
- ((looking-at "photons")
- (setq pov-completion-list pov-photons-keywords))
- ((looking-at pov-csg-scope-re)
- (setq pov-completion-list (append pov-solid-primitive-keywords pov-infinite-solid-keywords pov-object-modifier-keywords pov-csg-keywords)))
- (t
- (setq pov-completion-list (append pov-object-modifier-keywords pov-object-keywords))))
- (setq pov-completion-list (append pov-completion-list pov-transformation-keywords)))
- (setq pov-completion-list (append pov-top-level-keywords pov-solid-primitive-keywords pov-infinite-solid-keywords pov-patch-primitive-keywords pov-csg-keywords)))
- ;Append the language directives so that they are available at all places.
- (setq pov-completion-list (append pov-completion-list pov-global-keywords))))
- (defun pov-completion (pov-completion-str pov-completion-pred pov-completion-flag)
- (save-excursion
- (let ((pov-completion-all nil))
- (pov-get-scope)
- (mapcar '(lambda (s)
- (if (string-match (concat "\\<" pov-completion-str) s)
- (setq pov-completion-all (cons s pov-completion-all))))
- pov-completion-list)
- ;; Now we have built a list of all matches. Give response to caller
- (pov-completion-response))))
- (defun pov-completion-response ()
- (cond ((or (equal pov-completion-flag 'lambda) (null pov-completion-flag))
- ;; This was not called by all-completions
- (if (null pov-completion-all)
- ;; Return nil if there was no matching label
- nil
- ;; Get longest string common in the labels
- (let* ((elm (cdr pov-completion-all))
- (match (car pov-completion-all))
- (min (length match))
- tmp)
- (if (string= match pov-completion-str)
- ;; Return t if first match was an exact match
- (setq match t)
- (while (not (null elm))
- ;; Find longest common string
- (if (< (setq tmp (pov-string-diff match (car elm))) min)
- (progn
- (setq min tmp)
- (setq match (substring match 0 min))))
- ;; Terminate with match=t if this is an exact match
- (if (string= (car elm) pov-completion-str)
- (progn
- (setq match t)
- (setq elm nil))
- (setq elm (cdr elm)))))
- ;; If this is a test just for exact match, return nil ot t
- (if (and (equal pov-completion-flag 'lambda) (not (equal match 't)))
- nil
- match))))
- ;; If flag is t, this was called by all-completions. Return
- ;; list of all possible completions
- (pov-completion-flag
- pov-completion-all)))
- (defun pov-complete-word ()
- "Complete word at current point based on POV syntax."
- (interactive)
- (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9#_") (point)))
- (e (save-excursion (skip-chars-forward "a-zA-Z0-9#_") (point)))
- (pov-completion-str (buffer-substring b e))
- ;; The following variable is used in pov-completion
- ;(pov-buffer-to-use (current-buffer))
- (allcomp (all-completions pov-completion-str 'pov-completion))
- (match (try-completion
- pov-completion-str (mapcar '(lambda (elm)
- (cons elm 0)) allcomp))))
- ;; Delete old string
- (delete-region b e)
- ;; Insert match if found, or the original string if no match
- (if (or (null match) (equal match 't))
- (progn (insert "" pov-completion-str)
- (message "(No match)"))
- (insert "" match))
- ;; Give message about current status of completion
- (cond ((equal match 't)
- (if (not (null (cdr allcomp)))
- (message "(Complete but not unique)")
- (message "(Sole completion)")))
- ;; Display buffer if the current completion didn't help
- ;; on completing the label.
- ((and (not (null (cdr allcomp))) (= (length pov-completion-str)
- (length match)))
- (with-output-to-temp-buffer "*Completions*"
- (display-completion-list allcomp))
- ;; Wait for a keypress. Then delete *Completion* window
- (momentary-string-display "" (point))
- (delete-window (get-buffer-window (get-buffer "*Completions*")))))))
- ;;; initialize the keymap if it doesn't already exist
- (if (null pov-mode-map)
- (progn
- (setq pov-mode-map (make-sparse-keymap))
- (define-key pov-mode-map "{" 'pov-open)
- (define-key pov-mode-map "}" 'pov-close)
- (define-key pov-mode-map "\t" 'pov-tab)
- (define-key pov-mode-map "\r" 'pov-newline)
- (define-key pov-mode-map "\C-c\C-c" 'pov-command-query) ;AS
- (define-key pov-mode-map [(shift f1)] 'pov-keyword-help) ;AS
- (define-key pov-mode-map "\C-c\C-l" 'pov-show-render-output) ;AS
- (define-key pov-mode-map "\C-ci" 'pov-open-include-file)
- (define-key pov-mode-map "\M-\t" 'pov-complete-word)))
- ;; Hack to redindent end/else/break
- (if pov-autoindent-endblocks
- (progn
- (define-key pov-mode-map "e" 'pov-autoindent-endblock)
- (define-key pov-mode-map "k" 'pov-autoindent-endblock)
- (define-key pov-mode-map "d" 'pov-autoindent-endblock)))
- ; ***********************
- ; *** povkeyword help ***
- ; ***********************
- (defun pov-keyword-help nil
- (interactive)
- "look up the appropriate place for keyword in the POV documentation"
- "keyword can be entered and autocompleteted, default is word at point /AS"
- (let* ((default (current-word))
- (input (completing-read
- (format "lookup keyword (default %s): " default)
- pov-keyword-completion-alist))
- (kw (if (equal input "")
- default
- input)))
- (get-buffer-create pov-doc-buffer-name)
- (switch-to-buffer-other-window pov-doc-buffer-name)
- (find-file-read-only (concat pov-home-dir pov-help-file))
- ;;Try to look up a keyword in the povray-documentation:
- ;;uses a heuristic to find the appropriate entry
- ;;since the povray-docu is formatted rather arbitrarily
- ;;try:
- (cond
- ((progn
- (goto-char (point-min))
- (search-forward-regexp
- ;;first: the language description is in section four, so look for:
- (concat
- "^4\\.[0-9]+\\(\\.[0-9]+\\)?\\(\\.[0-9]+\\)?\\(\\.[0-9]+\\)?[ ]+"
- ;;change light_source -> light_source OR light source (that's
- ;;the usual spelling in the headings)
- ;;(wouldn't a working replace-in-string be nice, even for
- ;;FSF-emacs ???)
- (if (string-match "\\(.*\\)_\\(.*\\)" kw)
- (concat (match-string 1 kw)
- "[_ ]"
- (match-string 2 kw)
- ".*\\>$")
- kw))
- nil t)) ;return nil if not found
- ;; make the line of the match the top line of screen XXX
- (recenter 0))
- ;;second: if that didn't work:
- ;;same again with a relaxed regexp that allows more matches:
- ((progn
- (goto-char (point-min))
- (search-forward-regexp
- (concat
- "^4\\.[0-9]+\\(\\.[0-9]+\\)?\\(\\.[0-9]+\\)?\\(\\.[0-9]+\\)?[ ]+.*"
- (if (string-match "\\(.*\\)_\\(.*\\)" kw)
- (concat
- (match-string 1 kw)
- "[_ ]"
- (match-string 2 kw))
- kw))
- nil t))
- (recenter 0))
- ;;third try:
- ;;syntactic definitions appear like this: "KEYWORD:"
- ((progn
- (goto-char (point-min))
- (search-forward-regexp
- (concat "\\<" (upcase kw) ":")
- nil t)))
- ;;last try: simply search keyword from beginning of buffer
- ((progn
- (goto-char (point-min))
- (while (y-or-n-p (concat "Continue to look for " kw))
- (search-forward-regexp
- (concat "\\<" kw "\\>")
- nil t))))
- ;;OK, that's it: we failed
- (t (error (concat "Couldn't find keyword: " kw
- ", maybe you misspelled it?"))))
- ))
- ; **********************************
- ; *** Open standard include file ***
- ; **********************************
- (defun pov-open-include-file nil
- (interactive)
- "Open one of the standard include files"
- (let* ((default (current-word))
- (input (completing-read
- (format "File to open (default %s): " default)
- pov-keyword-completion-alist))
- (kw (if (equal input "")
- default
- input)))
- ;(get-buffer-create kw)
- ;(switch-to-buffer-other-window kw)
- ;(message (concat pov-include-dir (concat kw ".inc")))
- (find-file-read-only (concat pov-include-dir (concat kw ".inc")))
- ))
- ; ***************************
- ; *** Commands for povray ***
- ; ***************************
- ;;; Execution of Povray and View processes
- (defvar pov-next-default-command "Render" ;XXX
- "The default command to run next time pov-command-query is run")
- (defvar pov-last-render-command "Render" ;XXX
- "The last command used to render a scene")
- (defvar pov-rendered-succesfully nil
- "Whether the last rendering completed without errors")
- (defvar pov-doc-buffer-name "*Povray Doc*"
- "The name of the buffer in which the documentation will be displayed")
- ;; will be set to *Pov Render <buffer-name>*
- (defvar pov-render-buffer-name ""
- "The name of the buffer that contains the rendering output")
- (defvar pov-current-render-process nil
- "The process rendering at the moment or nil")
- (defvar pov-current-view-processes (make-hash-table)
- "The processes that display pictures at the moment")
- (defvar pov-buffer-modified-tick-at-last-render 0
- "The number of modifications at time of last render")
- ;;make all the render variables buffer-local that are pov-file
- ;;dependent, so that users can render more than one file at the same
- ;;time etc. Note: for the *view processes* a hash is used (rather
- ;;then making the variables local, because somebody might want to view
- ;;a file from a different render buffer.
- (mapc 'make-variable-buffer-local
- '(pov-command-alist ;because of history XXX
- pov-next-default-command
- pov-last-render-command
- pov-image-file
- pov-render-buffer-name
- pov-buffer-modified-tick-at-last-render
- pov-current-render-process))
- (defvar pov-image-file ""
- "The name of the rendered image that should be displayed"
- )
- (defun pov-default-view-command ()
- "Return the default view command (internal or external)"
- (if pov-default-view-internal
- pov-internal-view
- pov-external-view))
- (defun pov-command-query () ;XXX
- "Query the user which command to execute"
- ;;XXX this one is still a mess
- (interactive)
- ;;Check whether the buffer has been modified since last call,
- ;;and the last rendering was succesful. If so he probably
- ;;wants to render, otherwise he wants to view.
- (let* ((default
- (if (and (= (buffer-modified-tick)
- pov-buffer-modified-tick-at-last-render)
- pov-rendered-succesfully)
- (pov-default-view-command)
- pov-last-render-command))
- (completion-ignore-case t)
- (pov-command (completing-read
- (format "Which command (default: %s)? " default)
- pov-command-alist nil t nil t)))
- (setq pov-command
- (if (not (string-equal pov-command ""))
- pov-command
- default))
- (setq pov-next-default-command pov-command)
- ;;XXX argl: all this information should be in pov-command-alist
- (cond ((string-match pov-command pov-internal-view)
- (pov-display-image-xemacs pov-image-file)) ;XXX
- ((string-match pov-command pov-external-view)
- (pov-display-image-externally pov-image-file t))
- (t
- (setq pov-buffer-modified-tick-at-last-render
- (buffer-modified-tick))
- ; (message (format
- ; "DEBUG: buffer %s modified tick%d "
- ; (buffer-name)
- ; (buffer-modified-tick)))
- (pov-render-file pov-command (buffer-file-name) t)
- ))))
- (defun pov-render-file (pov-command file verify-render)
- "Render a file using pov-command."
- ;;XXX Check that there isn't already a render running
- (when
- (or
- (not pov-current-render-process)
- (and pov-current-render-process
- (cond ((y-or-n-p
- ;;XXX could theoretically be also running in other buffer...
- "There is a render process already running: abort it?")
- (kill-process pov-current-render-process)
- (message "Process killed")
- t)
- )))
- (let ((render-command nil)
- (render-command-options nil)
- (render-command-history nil)
- (old-buffer (current-buffer))
- (process nil))
- ;; if the user hasn't saved his pov-file, ask him
- (if (buffer-modified-p)
- (and (y-or-n-p
- (concat (buffer-name (current-buffer)) " modified; save ? "))
- (save-buffer)))
- ;; assign the buffer local value of the render buffer name
- (setq pov-render-buffer-name (format "*Povray Render %s*" file))
- (set-buffer (get-buffer-create pov-render-buffer-name))
- ;(switch-to-buffer (buffer-name)) % XXX use this for 2.11, and fix it
- (erase-buffer)
- (setq render-command (second (assoc pov-command pov-command-alist)))
- (setq render-command-options (format
- (third (assoc pov-command pov-command-alist))
- file))
- (setq render-command-history
- (fourth (assoc pov-command pov-command-alist)))
- ;(message (format "DEBUG FUCK %s %s"render-command-options (or
- ; render-command-history "NIL")))
- (if verify-render
- (setq render-command-options
- (read-string "Render with the following options: "
- render-command-options
- 'render-command-history)))
- (message (format "Running %s on %s" pov-command file))
- (insert (format "Running %s on %s with: %s %s..." pov-command file
- render-command render-command-options))
- (setq process (apply 'start-process pov-command (current-buffer)
- render-command
- (split-string render-command-options)))
- ;; memorize what we are doing
- (setq pov-last-render-command pov-command)
- ;; FIXME this might be dubious
- (setf (fourth (assoc pov-command pov-command-alist))
- render-command-history)
- ;;(message (format "DEBUG proc: %s" process))
- ;;XXX 'coz pov-current-render-process is buffer-local
- ;(get-buffer old-buffer)
- (set-buffer old-buffer)
- (setq pov-current-render-process process)
- (set-process-filter process 'pov-render-filter)
- (set-process-sentinel process 'pov-render-sentinel))))
- (defun pov-show-render-output ()
- "Pop up the output of the last render command."
- (interactive)
- (let ((buffer (get-buffer pov-render-buffer-name)))
- (if buffer
- (let ((old-buffer (current-buffer)))
- (pop-to-buffer buffer t)
- (bury-buffer buffer)
- (goto-char (point-max))
- (pop-to-buffer old-buffer))
- (error "No rendering done so far"))))
- (defun pov-render-sentinel (process event)
- "Sentinel for povray call."
- ;;so we aren't rendering any more ;XXX
- (setq pov-current-render-process nil)
- ;;If the process exists successfully then kill the ouput buffer
- (cond ((equal 0 (process-exit-status process))
- (setq pov-rendered-succesfully t)
- (message "Image rendered succesfully"))
- (t
- (message (concat "Errors in " (process-name process)
- ", press C-c C-l to display"))
- (setq pov-rendered-succesfully nil))))
- (defun pov-render-filter (process string)
- "Filter to process povray output. Scrolls and extracts the
- filename of the output image (XXX with a horrible buffer-local-hack...)"
- ;(message (format "DEBUG buffer name %s" (buffer-name (current-buffer))))
- (let ((image-file nil))
- (save-excursion
- (set-buffer (process-buffer process))
- (save-excursion
- ;; find out how our file is called
- (if (string-match "^ *Output file: \\(.*\\), [0-9]+ bpp .+$" string)
- (setq image-file (match-string 1 string)))
- (goto-char (process-mark process))
- (insert-before-markers string)
- (set-marker (process-mark process) (point))))
- (if image-file (setq pov-image-file image-file))))
- (defun pov-external-view-sentinel (process event)
- ;;seems like we finished viewing => remove process from hash
- (cl-remhash (process-name process) pov-current-view-processes)
- (if (equal 0 (process-exit-status process))
- (message (concat "view completed successfully")) ;XXX
- (message (format "view exit status %d"
- (process-exit-status process)))))
- (defun pov-display-image-externally (file verify-display)
- "Display the rendered image using external viewer"
- ;;if we don't have a file, prompt for one
- (when (or (not file) (string-equal file ""))
- (setq file
- (read-file-name "Which image file should I display? ")))
- (let ((view-command nil)
- (view-options nil)
- (view-history nil)
- (other-view (cl-gethash (concat pov-external-view file)
- pov-current-view-processes))
- (process nil))
- (if (and other-view (processp other-view)) ;external
- (if (not (y-or-n-p
- (format "Do yo want to want to kill the old view of %s?" file)))
- (kill-process other-view)))
- (setq view-command (second (assoc pov-external-view pov-command-alist)))
- (setq view-options (format
- (third (assoc pov-external-view pov-command-alist))
- file))
- (setq view-history (fourth (assoc pov-external-view pov-command-alist)))
- (if verify-display
- (setq view-options (read-string "View with the following options: "
- view-options
- view-history)))
- (message (format "Viewing %s with %s %s" file view-command view-options))
- (setq process (apply 'start-process (concat pov-external-view file) nil
- view-command (split-string view-options)))
- ;;; remember what we have done
- (cl-puthash (process-name process) process pov-current-view-processes)
- ;; update history
- (setf (fourth (assoc pov-external-view pov-command-alist)) view-history)
- ;;Sentinel for viewer call (XXX argl, what a hack)
- (set-process-sentinel process 'pov-external-view-sentinel)))
- ;; '(lambda (process event)
- (defun pov-display-image-xemacs (file)
- "Display the rendered image in a Xemacs frame"
- ;;TODO: set frame according to image-size (seems difficult)
- (when (or (not file) (string-equal file ""))
- (setq file
- (read-file-name "Which image file should I display? ")))
- (let ((buffer (get-buffer-create
- (format "*Povray View %s*" file))))
- (save-excursion
- (set-buffer buffer)
- (toggle-read-only -1)
- (erase-buffer)
- (insert-file-contents file)
- (toggle-read-only 1)
- ;;this will either bring the old frame with the picture to the forground
- ;;or create a new one
- (make-frame-visible
- (or (get-frame-for-buffer (current-buffer))
- (get-frame-for-buffer-make-new-frame (current-buffer)))))))
- ;(concat
- ; (third (assoc pov-command pov-command-alist))
- ; file
- ; *************
- ; *** Imenu ***
- ; *************
- (defun pov-helper-imenu-setup ()
- (interactive)
- (require `imenu) ;; Make an index for imenu
- (make-local-variable imenu-create-index-function)
- (setq imenu-create-index-function `pov-helper-imenu-index)
- (imenu-add-to-menubar "PoV")
- )
- ;; C.H.: to avoid flooding the function menu set 'pov-imenu-only-macros'
- (if pov-imenu-only-macros
- (defvar imenu-pov-declare-regexp
- (concat
- "\\(#macro\\)" ; Begin declaration
- "\\s-+" ; Whitespace
- "\\([A-Za-z_][A-Za-z_0-9]*\\)" ; Name
- ";?" ; A possible ; at the end
- )
- "Expression to recognize POV declares."
- )
- (defvar imenu-pov-declare-regexp
- (concat
- "#\\(declare\\|macro\\)" ; Begin declaration
- "\\s-+" ; Whitespace
- "\\([A-Za-z_][A-Za-z_0-9]*\\)" ; Name
- )
- "Expression to recognize POV declares."
- )
- )
- ;(defvar imenu-pov-declare-regexp
- ; (concat
- ; "^[ \t]*\\<#\\(declare\\|local\\|macro\\)\\>+[ \t]?"
- ; "\\([a-zA-Z0-9_*]+\\)+[ \t]?"
- ; ))
- (defun search-list (data-to-find list)
- (princ data-to-find)
- (message "")
- (princ list)
- (message "----")
- (cond ((null list) nil)
- ((null (car list)) (equal (car (car list)) (car data-to-find)))
- (t (if (equal (car (car list)) (car data-to-find))
- (setcar list (cons (car data-to-find)
- (cons (car list) data-to-find)))
- (search-list data-to-find (cdr list))
- ))
- )
- )
- (defun pov-helper-imenu-index ()
- "Return an table of contents for an html buffer for use with Imenu."
- ;(message "pov-helper-imenu-index")
- (let ((space ?\ ) ; a char
- (toc-index '())
- toc-str)
- (goto-char (point-min))
- (imenu-progress-message prev-pos 0)
- ;; Search
- (save-match-data
- (while (re-search-forward imenu-pov-declare-regexp nil t)
- ;(imenu-progress-message prev-pos)
- (setq toc-str (match-string 2))
- (beginning-of-line)
- (unless (search-list (cons toc-str (point)) toc-index)
- (setq toc-index (cons (cons toc-str (point)) toc-index)))
- (end-of-line)))
- ;(imenu-progress-message prev-pos 100)
- ;(if toc-index
- ;(princ (nreverse toc-index)))))
- (nreverse toc-index)))
- ;;; Renderdialog
- (defun pov-render-dialog ()
- "Opens a dialog to let you set the rending options"
- (interactive)
- (popup-dialog-box pov-render-dialog-desc)
- )
- ;; Let's try to find where the InsertMenu is located...
- (setq pov-insertmenu-location "EMACSLISPLIBRARY/InsertMenu")
- ;; (locate-data-directory "InsertMenu" (cons (file-name-directory
- ;; (locate-library "pov-mode"))
- ;; (if font-pov-is-Emacs
- ;; data-directory
- ;; data-directory-list))))
- (defun pov-im-get-submenunames ()
- (interactive)
- (pov-im-get-dirs (cddr (directory-files pov-insertmenu-location t)))
- )
- (defun pov-im-get-dirs (dirs)
- (when (eq dirs nil)
- (return ()))
- (catch '--cl-block-nil--
- (if (file-directory-p (car dirs))
- (return (cons
- (car dirs)
- (if (eq (cdr dirs) nil)
- nil
- (pov-im-get-dirs (cdr dirs)))
- ))
- (return (pov-im-get-dirs (cdr dirs)))))
- )
- (defun pov-im-make-menu ()
- (easy-menu-define
- pov-im-menu
- pov-mode-map
- "The POV-Ray Insert menu"
- (cons "Insert" (pov-im-create-menu (pov-im-get-submenunames))))
- )
- (defun pov-im-create-menu (dirs)
- (when (eq dirs nil)
- (return ()))
- (catch '--cl-block-nil--
- (return (cons
- (pov-im-create-submenu (car dirs))
- (if (eq (cdr dirs) nil)
- nil
- (pov-im-create-menu (cdr dirs)))
- )))
- )
- (defun pov-im-create-submenu (dir)
- (cons (substring (file-name-nondirectory dir) 5)
- (pov-im-get-menuitems (directory-files dir t ".*txt")))
- )
- (defun pov-im-get-menuitems (items)
- (when (eq items nil)
- (return nil))
- (catch '--cl-block-nil--
- (if (string-match "-.txt" (car items))
- (return (cons
- "----"
- (if (eq (cdr items) nil)
- nil
- (pov-im-get-menuitems (cdr items)))
- ))
- (if (string-match " - " (file-name-nondirectory (car items)))
- (return (cons
- (vector (substring (file-name-sans-extension
- (file-name-nondirectory (car items))) 5)
- (list 'pov-im-include-file (car items)) t)
- (if (eq (cdr items) nil)
- nil
- (pov-im-get-menuitems (cdr items)))
- ))
- (return (cons
- (vector (file-name-sans-extension
- (file-name-nondirectory (car items)))
- (list 'pov-im-include-file (car items)) t)
- (if (eq (cdr items) nil)
- nil
- (pov-im-get-menuitems (cdr items)))
- ))
- )))
- )
- (defun pov-im-include-file (file)
- (insert-file-contents file)
- )
- (provide 'pov-mode)
- ;;; pov-mode.el ends here
Submit a correction or amendment below (click here to make a fresh posting)
After submitting an amendment, you'll be able to view the differences between the old and new posts easily.